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*****  Introduction  ***** 

The  Computer  Center  makes  available  on  VAXcluster,  in  addition  to 
the  VMS  operating  system,  a  wide  variety  of  both  scientific  and  utility 
programs,  subprograms  and  procedures.  The  routines  are  maintained  in 

libraries  or  as  separate  files  in  the  VSYS:  directory. 

The  VLIB-Series  consists  of  the  following,  which  are  the  helps  for 
the  various  VAXcluster  "libraries"  maintained  by  the  Computer  Center: 

VLIB/D  -  Computer  Center  VAXcluster  Libraries  /  DTNSRDC 

(Commands  and  General  Information)  TM-18-8o~12 

VLIB/N  -  Computer  Center  VAXcluster  Libraries  /  NSRDC 

(Subprograms)  TM-18-86-13 

VLIB/P  -  Computer  Center  VAXcluster  Libraries  /  PROCFIL 

(Procedures)  TM-18-86-14 

VLIB/U  -  Computer  Center  VAXcluster  Libraries  /  UTILITY 

(Programs)  _  TM-18-86-15 

***  What's  In  This  Manual  *** 

A  list  of  the  routines  with  a  brief  description  of  each  is  followed 
by  the  list  of  functional  categories  used  to  classify  each  routine. 
N»xf  is  a  list  of  the  routines  under  the  various  categories.  Chapter  2 
contains  the  currently  available  HELP  modules  in  alphabetical  order. 


86/05/30 


VAX 


NSRDC 


Page  1-2 


****  Contents  **** 

The  following  subprograms  were  written  at  DTNSRDC  and  are  in  object  library 

VSYS:NSRDC.OLB.  For  help,  type  "HELP  0NSRDC  routine". 

AC  Character  function  to  get  current  job  order  number. 

ALFA  Test  character  for  alphabetic. 

ALFANU  Test  character  for  alphanumeric. 

ALFANUS  Test  character  string  for  alphanumeric. 

ALFAS  Test  character  string  for  alphabetic. 

BANR  Write  a  banner  (characters  are  10  lines  high;  lines  are  110 

positions  wide) . 

BANR6  Write  a  banner  (characters  are  6  lines  high;  lines  are  80 

positions  wide) . 

BITPKG  A  package  of  four  subprogtrams  to  give  high-level  language 

access  to  large  bit  arrays. 

ByCategory  Aist  of  modules  by  the  functional  category  to  which  each 

belongs . 

ByDate  List  of  modules  in  reverse  order  by  the  date  of  the  last 

modification  to  the  module  or  its  help. 

C2VDAT  Convert  CDC  format  date  (mm/dd/yy)  to  VMS  format 

(dd-mmm-yy) . 

CENTER  Integer  function  to  center  a  character  string.  The  string 

is  centered  within  itself. 


CHIN  Integer  function  to  convert  a  numeric  character  string  to  an 

integer . 

CLRBIT  Clear  one  bit  in  a  bit  array. 

CPU  Get  the  CPU  processor  for  this  node. 

CSHUFL  Shuffle  a  character  array. 

CSORT  Sort  (ascending)  a  character  array. 

CS0RT2  Sort  (ascending)  a  character  array  having  an  associated 

character  array. 

CS0RT2D  Sort  (descending)  a  character  array  having  an  associated 

character  array. 

CSORTD  Sort  (descending)  a  character  array. 


CSORTN 


Sort  (ascending)  a  character  array  having  an  associated 
non-character  array. 
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CSORTND 

DIGIT 

DIGITS 

FLPBIT 

FRSTCH 

GETSTR 

HMS2S 

IOSTATJTEXT 

ISORTC 

ISORTCD 

I  SUM 
ISVT100 
I TRANS 

JGDATE 

JPMODE 

LEFT 

L02UP 

LOWER 

LSTCH 

MAXAI 

MAXAR 

MAXINT 

MAXREAL 

MFRAME 


Sort  (descending)  a  character  array  having  an  associated 

non-character  array. 

Test  character  for  digit. 

Test  character  string  for  digit. 

Flip  one  bit  in  a  bit  array. 

Integer  function  to  return  the  position  of  the  first  non¬ 
blank  in  a  character  string. 

Extract  character  string  according  to  user-defined  criteria. 

Convert  hh:mm:ss  to  seconds. 

Convert  the  Fortran  I/O  status  code  to  a  message. 

Sort  (ascending)  an  integer  array  having  an  associated 

character  array. 

Sort  (descending)  an  integer  array  having  an  associated 

character  array. 

Sum  an  integer  array. 

Determine  if  output  file  (SYSSOUTPUT)  is  VT-100-cotnpatible. 

Integer  function  to  translate  characters  according  to 
translate  tables  you  specify  in  the  call. 

Convert  any  Gregorian  date  to  a  relative  Julian  number  or 
vice  versa. 

Get  the  job/process  mode  (batch,  interactive,  network,  other, 
or  unknown) . 

Integer  function  to  left-justify  a  character  string.  The 
string  is  left-justified  within  itself. 

Convert  lower  case  to  upper  case. 

Test  character  for  lower  case  letter. 

Integer  function  to  return  the  position  of  the  last  non¬ 
blank  in  a  character  string. 

Find  the  maximum  of  an  array  of  integers. 

Find  the  maximum  of  an  array  of  real  numbers. 

Return  the  maximum  integer  supported  by  VAX/VMS. 

Return  the  maximum  real  number  supported  by  VAX/VMS. 

Obtain  the  machine  and  node  running  the  program. 


wvu*. 
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MINAI  Find  the  minimum  of  an  array  of  integers. 

MINAR  Find  the  minimum  of  an  array  of  real  numbers. 

MININT  Return  the  minimum  integer  supported  by  VAX/VMS. 

MINREAL  Return  the  minimum  real  number  (absolute  value)  supported  by 

VAX/VMS. 

MOVEIT  Move  a  real  or  integer  array. 

NARGS  Determine  the  number  of  arguments  with  which  a  subprogram 

was  called. 

NEWFILETYPE  Replace  filetype  (and  version)  of  a  filespec. 

PARS  Parse  a  string. 

PARSEFILESPEC  Parse  a  file  specification,  that  is,  break  it  up  into  it's 
components . 

QUALCHAR  Extract  string  from  character  qualifier. 

QUALINT  Extract  string  from  integer  qualifier. 

QUALLOG  Extract  string  from  logical  qualifier. 

REPLAC  Replace  characters  in  a  string  with  a  character. 

REPLEQ  Replace  characters  in  a  string  with  other  characters. 

REPLNE  Replace  unspecified  characters  in  a  string  with  a  character. 

REVERSE  everse  the  order  of  characters  in  a  character  string. 

RIGHT  Integer  function  to  r ight-just i fy  a  character  string.  The 

string  is  right- jus t i f i ed  within  itself. 

S2HMS  Convert  seconds  to  hh:mm:ss. 


SETBIT  Set  one  bit  in  a  bit  array. 

SIGDIG  Return  number  of  significant  digits  (including  1  for  a  minus 

sign,  if  needed) 

SUM  Sum  a  real  array. 

SWAPCASE  Swap  lower  and  upper  case. 

SY  Solve  tridiagonal  system  of  equations  following  the  Thomas 

algor i thm. 

TERMINAL  For  interactive  users,  get  the  terminal  name. 

TRANS  Translate  characters  according  to  translate  tables  you 

specify  in  the  call. 


TSTARGDFT 


In  a  subprogram,  test  whether  a  specific  argument  in  the  call 


mmm 
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exists  and  is  not  defaulted. 

TSTBIT  Test  one  bit  in  a  bit  array. 

UP2LO  Convert  upper  case  to  lower  case. 

UPPER  Test  character  for  upper  case  letter. 

USERID  Get  user  initials. 

V2CDAT  Convert  VMS  format  date  (dd-mmm-yy)  to  CDC  format 

(mm/dd/yy) . 

WEKDAY  Find  the  day-of~the-week . 
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Functional  Categories 


Vr  >V  >'c 


The  following  functional  categories  are  used  at  DTNSRDC.  Those 
preceded  by  an  asterisk  (*)  are  local  DTNSRDC  categories.  All  others 
are  from  VIM  (the  CDC  users  group) . 


AO 


Arithmetic  routines 
Al  Real  numbers 
A2  Complex  numbers 
A3  Decimal 
A4  I/O  routines 


BO 


Elementary  functions 
B1  Trigonometric 
B2  Hyperbolic 

B3  Exponential  and  logarithmic 
B4  Roots  and  powers 


CO 


Polynomials  and  Special  functions 
Cl  Evaluation  of  polynomials 
Roots  of  polynomials 

Evaluation  of  special  functions  (non-statistical) 
Simultaneous  non-linear  algebraic  equations 
Simultaneous  transcendental  equations 
Roots  of  functions 


C2 

C3 

C4 

C5 

C6 


DO  Operations  on  functions  and  solutions  of  differential  equations 
D1  Numerical  integration 

D2  Numerical  solutions  of  ordinary  differential  equations 
D3  Numerical  solutions  of  partial  differential  equations 
D4  Numerical  differentiation 


E0 


Interpolation  and  approximations 
El  Tsble  look-up  and  interpolation 
E2  Curve  fitting 
E3  Smoothing 

E4  Minimizing  or  maximizing  a  function 


F0 


Operations  on  matrices,  vectors  &  simultaneous  linear  equations 
FI  Vector  and  matrix  operations 
F2  Eigenvalues  and  eigenvectors 
F3  Determinants 

F4  Simultaneous  linear  equations 


GO  Statistical  analysis  and  probability 


9 

G1 

Data  reduction  (common  statistical  parameters) 

S 

G2 

Correlation  and  regression  analysis 

Ov 

G3 

Sequential  analysis 

■£ 

G4 

Analysis  of  variance 

G5 

Time  series 

G6 

Special  functions  (includes  random  numbers  and  pdf's) 

*  G7 

Multivariate  analysis  and  scale  statistics 

[y 

*  G8 

Non-parametric  methods  and  statistical  tests 

& 

*  G9 

Statistical  inference 

7  V 


\tl 


•SI 
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HO  Operations  research  techniques,  simulation  &  management  science 


Linear  programming 


H2  Non-linear  programming 


Transportation  and  network  codes 
Simulation  modeling 
Simulation  models 
Critical  path  programs 
Auxiliary  programs 


H9  Combined 


10  Input 

11  Binary 

12  Octal 

13  Decimal 

IA  BCD  (Hollerith) 
19  Composite 


JO  Output 

J1  Binary 


J2  Octal 
J3  Decimal 
JA  BCD  (Hollerith) 
J5  Plotting 
J7  Analog 
J9  Composite 


Internal  information  transfer 


External-to-external 

Internal- to- internal  (relocation) 

Disk 


KA  Tape 


Direct  data  devices 


L0  Executive  routines 
Ll  Assembly 
L2  Compiling 
L3  Monitoring 
LA  Preprocessing 

L5  Disassembly  and  derelat ivizing 
L6  Relativizing 

L7  Computer  language  translators 


MO  Data  handling 
Ml  Sorting 

M2  Conversion  and/or  scaling 
M3  Merging 

MA  Character  manipulation 
M5  Searching,  seeking,  locating 
M6  Report  generators 
M9  Composite 


Debugging 

N1  Tracing  and  trapping 
N2  Dumping 

N3  Memory  verification  and  searching 
NA  Breakpoint  printing 
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00  Simulation  of  computers  and  data  processors  (interpreters) 

01  Off-line  equipment  (listers,  reproducers,  etc.) 

03  Computers 
04  Pseudo-computers 

05  Software  simulation  of  peripherals 
09  Composite 

P0  Diagnostics  (hardware  malfunction) 

QO  Service  or  housekeeping,  programming  aids 
Q1  Clear/reset 

Q2  Checksum  accumulation  and  correction 
Q3  File  manipulation 

Q4  Internal  housekeeping,  save,  restore,  etc. 

Q5  Report  generator  subroutines 

Q6  Program  documentation:  flow  charts,  document  standardization 
Q7  Program  library  utilities 

RO  Logic  and  symbolic 
Rl  Formal  logic 
R2  Symbol  manipulation 
R3  List  and  string  processing 
R4  Text  editing 

SO  Information  retrieval 

TO  Applications  and  appl ication-or iented  programs 
T1  Physics  (including  nuclear) 

T2  Chemistry 

T3  Other  physical  sciences  (geology,  astronomy,  etc.) 

T4  Engineering 
T5  Business  data  processing 

T6  Manufacturing  (non-data)  processing  and  process  control 
T7  Mathematics  and  applied  mathematics 
T8  Social  and  behavioral  sciences  and  psychology 
T9  Biological  sciences 

T10  Regional  sciences  (geography,  urban  planning) 

Til  Computer  assisted  instruction 

U0  Linguistics  and  languages 

VO  General  purpose  utility  subroutines 
VI  Random  number  generators 

V2  Combinatorial  generators:  permutations,  combinations  &  subsets 
*  V3  standard  and  special  problems 

XO  Data  reduction 

Xl  Re-formatting,  decomrautat i on ,  error  diagnosis 
X2  Editing 
X3  Calibration 
X4  Evaluation 

X5  Analysis  (time-series  analysis) 

X6  Simulation  (generate  test  data  for  data  reduction  system) 

YO  Installation  modification 

Yl  Installation  modification  library 
Y2  NEWPL  tape  of  installation  modi f icat ions 

ZO  All  others 
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****  By  Functional  Category  **** 
(13-JUN-86  @  08:39:22) 


The  modules  in  this  library  are  listed  below  by  functional  category. 

(E  -  executable  program;  F  -  function  subprogram;  P  -  procedure; 

S  -  subroutine  subprogram;  Z  -  miscellaneous) 

Al  Real  numbers 

F-ISUM  F-SUM 

FA  Simultaneous  linear  equations 
S-SY 

J4  BCD  (Hollerith) 


S-BANR 

S-BANR6 

Ml  Sorting 
S-CSHUFL 
S-CSORTN 

S-CSORT 

S-ISORTC 

• 

S-CS0RT2 

S-ISORTCD 

S-CS0RT2D 

S-CSORTD 

M2  Conversion 
S-C2VDAT 
S-S2HMS 

and/or  scaling 
S-CHIN 
S-UP2LO 

S-HMS2S 

S-V2CDAT 

S-JGDATE 

S-L02UP 

M4  Character  manipulation 
S-ALFA  S-ALFANU 

S-CENTER  S-CLR  BIT 

F-GETSTR  S- I TRANS 

S-NEWFILETYP  F-QUAl_CHAR 

F-REPLEQ  F-REPLNE 

S-SWAPCASE  S-TRANS 

S-ALFANUS 

S-DIGIT 

S-LEFT 

F-QUAL_INT 

S-REVERSE 

F-TST_ARG_DF 

S-ALFAS 

S-DIGITS 

S-LOWER 

F-QUAL  LOG 

S-RIGHT 

F-TST_BIT 

Z-BIT  PKG 
S-FLP  BIT 
S-MOVEIT 
F-REPLAC 
S-SET  BIT 
S-UPPER 

M5  Searching, 
F-FRSTCH 
F-MAXINT 
F-MINREAL 

seeking,  locating 

F-GETSTR  F-LSTCH 

F-MAXREAL  F-MINAI 

F-PARS  S-PARSE_FILE 

F-MAXAI 

F-MINAR 

F-MAXAR 

F-MININT 

Q0  Service  or 
F-AC 

F-NARGS 

housekeeping, 

F-CPU 

S-SIGDIG 

programming  aids 
F-IS  VT100 
F-TERMINAL 

F-JP  MODE 
S-USERID 

S-MFRAME 

S-WEKDAY 

Q3  File  manipulation 
S-IOSTAT  TEX 
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*****  Individual  Documents  ***** 

This  chapter  contains  the  HELP  modules  for  all  routines  and  general 
information  in  "library"  NSRDC. 

For  the  most  recent  on-line  HELPs,  type 

HELP  @NSRDC  <routine> 

To  see  the  current  contents,  type 

HELP  0NSRDC  Contents 

To  see  the  most  recently  changed  routines  of  HELPs,  type 
HELP  0NSRDC  By_Date 

To  see  the  current  functional  category  list  of  the  modules,  type 
HELP  0NSRDC  By_Category 


*>i| 
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Character  function  to  get  the  current  job  order  number. 
Usage:  CHARACTER  AC  *  10,  JON  *  10 

JON  -  AC  () 
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*** 


Parameters  *** 


AC  () 


AC  -  out  -  ch*10  -  will  contain  the  current  job  order  number 


it-ki c 


Example  *** 


AC  () 


CHARACTER  AC  *  10,  JON  *  10 
INTEGER  CHIN,  NUMBER 
•  •  • 

JON  -  AC  () 

PRINT  *,  'The  current  job  order  number  is',  JON, 


86/05/30 


VAX 


NSRDC 


ALFA 


Page  2-3 


****  ALFA  **** 

Test  a  character  for  alphabetic. 

I’ sage :  CHARACTER  *  1  CH 

LOGICAL  ALFA 

IF  (ALFA(CH))  THEN 


CH  -  in  ch*l  -  character  to  be  tested 


‘t 

el 


ALFA  -  out  -  log  -  TRUE  -  CH  is  alphabetic 

FALSE  -  CH  is  not  alphabetic 


Example  *** 

ALFA  (CH) 

Read  a  character  string  and  flag  all  alphabetic  characters. 

CHARACTER  STRING  *  50,  FLAGS  *  50 
FLAGS  -  '  ' 

READ  (*,  '(A)')  STRING 
DO  110  N-1,50 

IF  (ALFA  (STRING(N:N)))  FLAGS (N:N)  =  ,A’ 

110  CONTINUE 

PRINT  *,  STRING 
PRINT  *,  FLAGS 


UvWxy  Z123A567890O5 


f 

I 
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****  ALFANU 

Test  a  character  for  alphanumeric. 

Usage:  CHARACTER  *  1  CH 

LOGICAL  ALFANU 

IF  (ALFANU (CH))  THEN 


ir  ?V 


Parameters 


ALFANU  (CH) 

CH  -  in  ch*l  -  character  to  be  tested 

ALFANU  -  out  -  log  -  TRUE  -  CH  i s  alphanumeric 

FALSE  -  CH  is  not  alphanumeric 


***  Example  *** 


ALFANU  (CH) 

Read  a  character  string  and  flag  all  alphanumeric  characters. 


•  •  • 

CHARACTER  STRING  *  50,  FLAGS  *  50 
•  •  • 

FLAGS  =  '  ' 

READ  (*,  '(A)')  STRING 
DO  110  N= 1 , 50 

IF  (ALFANU  (STRING(N:N) ) )  FLAGS (N : N)  « 
110  CONTINUE 

PRINT  *,  STRING 
PRINT  *,  FLAGS 


Then, 


for 


string5* '  abcde 
flags  «,AAAAA 


FGHIJ  kLmnO  pQRst 

A  A  A  A  A  A  A  A  A  A  A  A  A  A  A 


UvWxy  Z1234567890 () $ 
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****  ALFANUS  **** 

Test  a  character  string  for  alphanumeric. 

Usage:  CHARACTER  *  (N)  STRING 

LOGICAL  ALFANUS 

IF  (ALFANUS (STRING))  THEN 


Parameters 


ALFANUS  (STRING) 

STRING  -  in  ch**  -  string  to  be  tested 

ALFANUS  -  out  -  log  -  TRUE  -  string  was  alphanumeric 

FALSE  -  string  was  not  alphanumeric 


***  Example  *** 

ALFANUS  (STRING) 

Read  a  character  string  and  test  for  all  alphanumeric. 


•  •  • 

CHARACTER  STRING  *  10 

READ  (*,  '(A)')  STRING 
IF  (ALFANUS  (STRING (N:N) ) )  THEN 

PRINT  *,  'The  string  is  all  alphanumeric.' 

ELSE 

PRINT  *,  'The  string  has  at  least  one  non-alphanumeric  character.' 
END  IF 


Then  for  STRING* ' ab3defg8i j ' ,  this  program  segment  prints: 
The  string  is  all  alphanumeric. 

For  STRING* ' abcde6*hij ' ,  this  program  segment  prints: 

The  string  has  at  least  one  non-alphanumeric  character. 
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****  ALFAS  **** 

Test  a  character  string  for  alphabetic. 

Usage:  CHARACTER  *  (N)  STRING 

LOGICAL  ALFAS 

IF  (ALFAS (STRING))  THEN 


it  it  it 


Parameters 


*** 


ALFAS  (STRING) 

STRING  -  in  ch**  -  string  to  be  tested 

ALFAS  -  out  -  log  -  TRUE  -  string  was  alphabetic 

FALSE  -  string  was  not  alphabetic 


Example  *** 


ALFAS  (STRING) 

Read  a  character  string  and  test  for  all  alphabetic. 


CHARACTER  STRING  *  10 
•  *  • 

READ  (*,  '(A)')  STRING 
IF  (ALFAS  (STRING (N:N)))  THEN 

PRINT  *,  'The  string  is  all  alphabetic.' 

ELSE 

PRINT  *,  'The  string  has  at  least  one  non-alphabetic  character.' 
END  IF 


Then  for  STRING* ' abcdefghij ' ,  this  program  segment  prints: 
The  string  is  all  alphabetic. 

For  STRING* ' abcde6ghij ' ,  this  program  segment  prints: 

The  string  has  at  least  one  non-alphabetic  character. 
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****  BANR  **** 

Write  a  banner  (characters  are  10  lines  high;  lines  are  110  positions  wide). 

Usage:  INTEGER  OUTPUT_UNIT,  WHERE_ON_PAGE 

•  •  • 

CALL  BANR  ('message',  OUTPUT_UNIT,  WHERE  ON  PAGE) 


***  Parameters  *** 

CALL  BANR  ('message',  OUTPUT_UNIT,  WHERE_ON_PAGE) 

MESSAGE  -  in  -  ch**  -  string  to  be  printed 

(10  characters  maximum) 

OUTPUT_UNIT  -  in  -  int  -  unit  number  for  output 

(for  standard  output  file,  use  -1) 

WHERE_ON_PAGE  -  in  -  int  -  0  -  put  banner  on  new  page 

<>0  -  put  banner  on  same  page 

At  present,  BANR  supports  only  the  CDC  63-character  set: 

ABCDEFGHI JKLMNOPQRSTUVWXYZ0123456789+-*/ () $*  , .#[] ?<>@\A ; 

***  Example  *** 

CALL  BANR  ('message',  OUTPUTJJNIT,  WHER E_0N_PAGE) 

Write  a  2-line  banner  page  with  SHIP  // 

<ship  number> 

on  the  standard  output  file. 

CHARACTER  SHIPNO  *  10 
•  •  ■ 

READ  ' (A) ' ,  SHIPNO 

CALL  BANR  ('SHIP  #' ,  -1,  0) 

CALL  BANR  (SHIPNO,  -1,  1) 


a 


9 
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****  BANR6  ****  A. 

$0 

Write  a  banner  (characters  are  6  lines  high;  lines  are  80  positions  wide). 

Usage:  INTEGER  OUTPUTJJNIT,  WHERE  J)N_PAGE 

CALL  BANR6  ('message',  OUTPUTJJNIT,  WHERE_ON_PAGE) 


***  Parameters  *** 

CALL  BANR6  ('message',  OUTPUTJJNIT,  WHERE_ON_PAGE) 

MESSAGE  -  in  -  ch**  -  string  to  be  printed 

(10  characters  maximum) 

OUTPUTJJNIT  -  in  -  int  -  unit  number  for  output 

(for  standard  output  file,  use  -1) 

WHERE J)N_P AGE  -  in  -  int  -  0  -  put  banner  on  new  page 

<>0  -  put  banner  on  same  page 

At  present,  BANR  supports  only  the  CDC  63-character  set: 

ABCDEFGHI JKLMNOPQRSTUVWXYZ0123456789+-*/ 0  $-  , . #  [] : ' ?<»@\A ; 

***  Example  *** 

CALL  BANR6  ('message',  OUTPUTJJNIT,  WHERE  J)N_P AGE) 

Write  a  2~line  banner  page  with  SHIP  # 

<ship  number> 

on  the  standard  output  file. 

CHARACTER  SHIPNO  *  10 

READ  ' (A) ' ,  SHIPNO 

CALL  BANR6  (’SHIP  #' ,  -1,  0) 

CALL  BANR6  (SHIPNO,  -1,  1) 
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****  BIT  PKG  **** 


This  package  provides  high-level  language  access  to  large  bit  arrays. 


It  provides  for  setting,  clearing,  flipping,  and  testing  individual  bits 
in  a  bit  array  or  string. 


***  CLR  BIT 


Clear  one  bit  in  a  bit  array  (bit  string) 


Usage:  CALL  CLR_BIT  (BITNO.rl.r,  BITS.mv.r) 


Parameters 


CALL  CLR  BIT  (BITNO.rl.r,  BITS.mv.r) 


BITNO  -  in  -  int  -  the  number  of  the  bit  to  be  cleared 


BITS  -  i/o  - 


-  the  bit  string  or  array 


Examp 1 e 


Clear  bit  76  in  a  100-bit  table: 


INTEGER  NBITS,  BITS_WORD,  N_WORDS 
PARAMETER  (  BITS_WORD  =  32  !  integer*4  word 

N  ,  N_B ITS  =  100  !  in  bit  array 

N  ,  N_W0RDS  =  (N_BITS  +  BITS_W0RD  -  1)  /  BITS_WORD 

)  ) 

INTEGER  BITNO,  TABLE (N  WORDS) 


BITNO  -  76 

CALL  CLR  BIT  (BITNO,  TABLE) 


FLP  BIT 


Flip  one  bit  in  a  bit  array  (bit  string). 


Usage:  CALL  FLP_BIT  (BITNO.rl.r,  BITS.mv.r) 


Parameters 


CALL  FLP  BIT  (BITNO.rl.r,  BITS.mv.r) 


mm 


a 


if 


A* 


■,',k 

'•’I 


4 

I 


a 


& 


1 


*8 


i 


Si 


a 


I 
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BITNO  -  in  int  -  the  number  of  the  bit  to  be  flipped 


BITS  -  i/o 


the  bit  string  or  array 


Example 


Flip  bit  76  in  a  100-bit  table: 


integer  n_bits,  bits_word,  n_words 
PARAMETER  (  BITS_WORD  =  32  !  integer*4  word 

N  ,  N_BITS  =  100  !  bit  array 

N  ,  N_WORDS  =  (N_BITS  +  BITS  WORD  -  1)  /  BITS  WORD 

)  )  " 

INTEGER  BITNO,  TABLE (N  WORDS) 


BITNO  *  76 

CALL  FLP  BIT  (BITNO,  TABLE) 


***  SET  BIT 


Set  one  bit  in  a  bit  array  (bit  string). 


Usage:  CALL  SET_BIT  (BITNO. rl.r,  BITS.mv.r) 


Parameters 


CALL  SET  BIT  (BITNO. rl.r,  BITS.mv.r) 


BITNO  -  in  -  int  -  the  number  of  the  bit  to  be  set 


BITS  -  i/o  - 


-  the  bit  string  or  array 


Example  ** 


Set  bit  76  in  a  100-bit  table: 


integer  n_bits,  bits_word,  n_words 
PARAMETER  (  BITS_WORD  -  32  ’  integer*4  word 

N  ,  N_BITS  =  100  in  bit  array 

N  ,  N_WORDS  =  (N_B ITS  +  BITS  WORD  -  1)  /  BITS  WORD 

)  ) 

INTEGER  BITNO,  TABLE (N  WORDS) 


BITNO  =  76 

CALL  SET  BIT  (BITNO,  TABLE) 


TST  BIT  *** 
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Test  one  bit  in  a  bit  array  (bit  string). 

Usage:  LOGICAL  BIT_SET ,  TST_BIT 

BIT_SET  =  TST_BIT  (BITNO.rl.r,  BITS.mv.r) 

**  Parameters  ** 

TST_BIT  (BITNO.rl.r,  BITS.mv.r) 

BITNO  -  in  int  -  the  number  of  the  bit  to  be  tested 

BITS  -  i/o  -  -  the  bit  string  or  array 

TST_BIT  -  out  -  log  -  TRUE  -  the  bit  is  set 

FALSE  -  the  bit  is  not  set 


**  Example  ** 

Test  bit  76  in  a  100-bit  table  and  print  a  message: 

INTEGER  N_BITS,  BITS_WORD,  NWORDS 
PARAMETER  (  BITS_WORD  =  32  !  integer*^  word 

N  ,  N_BITS  -  100  !  in  bit  array 

N  ,  N_WORDS  -  (N_BITS  +  BITS_WORD  -  1)  /  BITS_WORD 

)  ) 

INTEGER  BITNO,  TABLE (N_WORDS) 

LOGICAL  TST_BIT 

BITNO  =  76 

IF  (TST_BIT  (BITNO,  TABLE))  THEN 

PRINT  *,  'Bit  ',  BITNO,  '  is  set.' 

ELSE 

PRINT  *,  'Bit  ’ ,  BITNO,  ’  is  not  set.’ 

END  IF 


***  Admin  info  *** 


Authors : 


F.  Nagy  -  Fermilab  Accelerator  Control  System  (clr_bit, 
set_bit,  t  s  t_b it) 

David  V.  Sommer  -  DTNSRDC  Code  1892.2  (flp  bit) 


Languages:  MACRO  (clr_bit,  set  bit,  tst_bit) 

Fortran  77  (flp_bit/ 


Date  written:  01/17/83  (clr_bit,  set_bit,  tst_bit) 
08/30/85  (flp_bit) 


Dates  revised 
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*>'oVV r  C2  VDAT  **** 

Convert  CDC  format  date  (mm/dd/yy)  to  VMS  format  (dd-mmm-yy) . 
Usage:  CHARACTER  CDC  *  8,  VMS  *  9 

CALL  C 2 VDAT  (CDC,  VMS) 


***  Parameters  *** 

CALL  C2VDAT  (CDC,  VMS) 

CDC  -  in  -  ch*8  -  CDC  format  date  to  be  converted  (mm/dd/yy) 
VMS  -  out  -  ch*9  -  VMS  format  converted  date  (dd-mmm-yy) 


Example 


CALL  C2VDAT  (CDC,  VMS) 

CHARACTER  CDC  *  8,  VMS  *  9 

CDC  -  '04/11/85' 

CALL  C2VDAT  (CDC,  VMS) 

TYPE  *,  ’CDC  date  is  ’ ,  CDC 
TYPE  *,  'VMS  date  is  ',  VMS 

results  in  the  following  output: 

CDC  date  is  04/11/85 
VMS  date  is  11 -APR-85 


* 
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****  CENTER  **** 


Integer  function  to  center  a  character  string.  The  string 
within  itself. 

Usage:  CHARACTER  STRING  *  (n) 

CHARACTER  WORK  *  (n) 

INTEGER  CENTER,  LSTRING 

LSTRING  =  CENTER  (STRING,  WORK) 


*’”•  Parameters  *** 

CENTER  (STRING,  WORK) 

STRING  -  i/o  -  ch**  -  string  to  be  centered 

WORK  -  -  ch**  -  work  variable  of  len(string) 

CENTER  -  out  -  int  -  the  position  of  the  last  non- 


Example  *** 


CENTER  (STRING, WORK) 

CHARACTER  LINE  *  20 
CHARACTER  WORK  *  20 
INTEGER  CENTER,  LLINE 

READ  ' (A) ' ,  LINE 

LLINE  «  CENTER  (LINE,  WORK) 


If  LINE  contains  'Some  words 
will  contain  '  Some  words 

1. . .5. . . 10. . . 15 


'  ,  then  after  cen 
'  ,  and  LLINE  -  15 


is  centered 


blank 


tering,  LINE 
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****  CHIN  ***** 

Integer  function  to  convert  a  numeric  character  string  to  an  integer. 

Usage:  CHARACTER  STRING  *  (n) 

INTEGER  CHIN 

NUMBER  =  CHIN  (STRING) 


Parameters 


*** 


CHIN  (STRING) 
STRING 
CHIN 


in  -  ch**  -  string  to  be  converted 
out  -  int  -  integer  value  of  string 


>Y  Vc  >Y 


Example 


Irk* 


CHIN  (STRING) 


CHARACTER  LINE  *  10 
INTEGER  CHIN,  NUMBER 
•  •  • 

READ  ' (A) ’ ,  LINE 
NUMBER  =  CHIN  (LINE) 

PRINT  *,  'The  value  of  LINE,  '  is',  NUMBER 
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****  CLR_BIT  **** 

w 

Clear  one  bit  in  a  bit  array  (bit  string). 

Usage:  CALL  CLR_BIT  (BITNO.rl.r,  BITS.mv.r) 

See  also  FLP_BIT,  SET_BIT,  TST_BIT;  help  module  BIT_PKG. 


***  Parameters  *** 

CALL  CLR_BIT  (BITNO.rl.r,  BITS.mv.r) 

BITNO  -  in  -  int  -  the  number  of  the  bit  to  be  cleared 
BITS  -  i/o  -  -  the  bit  string  or  array 


***  Example  *** 
Clear  bit  76  in  a  100-bit  table: 


INTEGER  NBITS,  BITS_WORD,  NWORDS 
PARAMETER  (  BITSWORD  ■  32  !  integer*^  word 

N  ,  NBITS  *  100  !  in  bit  array 

N  ,  NWORDS  »  (N_BITS  +  BITS_WORD  -  1)  /  BITSWORD 

)  ) 

INTEGER  BITNO,  TABLE (N_WORDS) 

BITNO  =  76 

CALL  CLRBIT  (BITNO,  TABLE) 


***  Admin_info  *** 

Author:  F.  Nagy  -  Fermilab  Accelerator  Control  System 

Languages:  MACRO 

Date  written:  01/17/83 
Dates  revised 


WT* 

**  I.  ■  > 
.  ^  %  H 

"  s*  V 


a 
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****  CPU  **** 


Get  the  CPU  processor  for  this  node. 

usage:  CHARACTER  *  A  CPU,  THIS_CPU 

*  «  # 

THIS  CPU  -  CPU  () 


***  Parameters  *** 


CPU  () 

CPU  -  out  -  ch**  -  one  of:  'V780'  (780,  782,  or  785) 

' V750 ' 

' V730 ' 

' VMIC '  (MicroVAX) 


***  Examples  *** 

CHARACTER  *  A  CPU,  THISCPU 
•  •  • 

THIS_CPU  »  CPU  () 

PRINT  *,  ’This  is  running  on  a  ' ,  THIS_CPU, 

***  Admin_info  *** 

Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  08/21/85 
Dates  revised 
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****  CSHUFL  **”* 

Shuffle  a  character  array. 

Usage:  INTEGER  NELTS,  SUBARY (NELTS) 

CHARACTER  ORIG(NELTS)  *  (n) ,  REORDR (NELTS)  *  (n) 
CHARACTER  WORK (NELTS)  *  1 

CALL  CSHUFL  (ORIG,  NELTS,  REORDR,  SUBARY,  WORK) 

See  also  CSORT,  CSORTD;  CS0RT2 ,  CS0RT2D;  CSORTN,  CSORTND;  ISORTC, 
ISORTCD. 


?‘r  Vr  * 


Parameters 


icitit 


CALL  CSHUFL  (ORIG,  NELTS,  REORDR,  SUBARY,  WORK) 


ORIG 

in 

ch** 

-  original 

array  to  be  shuffled 

NELTS  - 

in 

int 

-  number  of 

elements  to  be  shuffled 

REORDR  - 

out  “ 

ch** 

-  shuffled 

array 

SUBARY  - 

out  “ 

int 

-  array  to 

contain  the  reordered  subscripts 

(the  original  position  of  REORDR (i)  is 
ORIG(SUBARY (i) ) ) 


WORK  -  out  -  ch*l  -  work  array 


Example  *** 


Sort  a  character  array  into  ascending  order. 

CHARACTER  *  4  ORIG (10)  /  'AMDS',  ’ CACR ’ ,  ’CASG’,  ’CAWE',  ’CASR’, 
A  ' CAKB ' ,  ' CABT ' ,  'CAHS',  'CAHB ' ,  ' CAMK ' / 

CHARACTER  *  4  REORDR (10) ,  WORK(IO) 

INTEGER  SUBARY (10) 

CALL  CSHUFL  (ORIG,  10,  REORDR,  SUBARY,  WORK) 


After  the  sort,  REORDR  will  contain  the  elements  of  ORIG  in  a  random 
order.  The  i~th  element  of  SUBARY  will  point  to  the  original  position 
of  REORDR (i)  in  the  ORIG  array,  that  is,  OR IG (SUBARY (i) )  =  REORDR (i) . 
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****  CSORT  **** 

Sort  (ascending)  a  character  array. 

Usage:  INTEGER  NELTS 

CHARACTER  CARRAY (NELTS)  *  (n) ,  CTEMP  *  (n) 

CALL  CSORT  (CARRAY,  NELTS,  CTEMP) 

See  also  CSHUFL;  CSORTD;  CS0RT2,  CS0RT2D;  CSORTN,  CSORTND;  ISORTC, 
ISORTCD. 


***  Parameters  *** 

CALL  CSORT  (CARRAY,  NELTS,  CTEMP) 

CARRAY  -  i/o  -  ch**  -  array  to  be  sorted 

NELTS  -  in  int  -  number  of  elements  to  be  sorted 

CTEMP  -  out  -  ch**  -  variable  of  the  same  length  as  CARRAY, 

used  for  swapping 


Example  *** 


Sort  a  character  array  into  ascending  order. 


CHARACTER  CARRAY (3) 
A 

CHARACTER  WORK 


INTEGER  NELTS  /  3  / 
CALL  CSORT  (CARRAY, 


*  20  /  !  array  to  be  sorted 

'CASG...',  'AMDS...', 

*  20  !  work  element  for  the 

!  at  least  as  large  as 
!  CARRAY) 

!  number  of  records  to 
NELTS,  WORK) 


' CACR . . . '  / 
sort  (must  be 
the  length  of 

be  sorted 


After  the  sort,  CARRAY  will 


contain  'AMDS...',  'CACR...', 


'CASG.  . .  ' 
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****  CSORT2  **** 

Sort  (ascending)  a  character  array  with  an  associated  character  array. 

Usage  INTEGER  NELTS 

CHARACTER  CARRAY (NELTS)  *  (n) ,  CTEMP  *  (n) 

CHARACTER  ASSOC (NELTS)  *  (m) ,  CTEMPA  *  (m) 

CALL  CSORT  (CARRAY,  NELTS,  CTEMP,  ASSOC,  CTEMPA) 

See  also  CSHUFL;  CSORT,  CSORTD;  CS0RT2D;  CSORTN,  CSORTND;  ISORTC, 
ISORTCD. 


Parameters 


*  jfcVc 


CALL  CS0RT2  (CARRAY,  NELTS,  CTEMP,  ASSOC,  CTEMPA) 


CARRAY  - 

i/o 

-  ch** 

-  array  to 

be  sorted 

NELTS  - 

in 

-  int 

-  number  of 

elements  to  be  sorted 

CTEMP  - 

out 

-  ch** 

-  variable 
used  for 

of  the  same  length  as  CARRAY, 
swapping 

ASSOC  - 

i/o 

-  ch** 

-  associated  character  array  which  will 

be  re-ordered  to  maintain  a  1-to-l  corre¬ 
spondence  with  the  elements  of  CARRAY 

CTEMPA  -  out  -  ch,;*  -  variable  of  same  length  as  ASSOC,  used  for  swapping 


Example  *** 


Sort  a  character  array  with  an  associated  character  array  into  ascending 
order . 

CHARACTER  CARRAY (3)  *  20  / 

A 

CHARACTER  ASSOC (3)  *  55 

CHARACTER  WORK  *  55 


INTEGER  NELTS  /  3  / 

CALL  CS0RT2  (CARRAY,  NELTS,  WORK,  ASSOC,  WORK) 


!  array  to  be  sorted 
'CASG...',  'AMDS...',  'CACR...'  / 

!  associated  array 

!  work  element  for  the  sort  (must  be 
!  at  least  as  large  as  the  maximum  of 
!  the  length  of  CARRAY  and  the  length 
!  of  ASSOC) 

!  number  of  records  to  be  sorted 


After  the  sort,  CARRAY  will  contain  'AMDS...',  'CACR...',  'CASG... 
ASSOC  will  contain  the  corresponding  data. 
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****  CS0RT2D  **** 

Sort  (descending)  a  character  array  with  an  associated  character  array 

Usage:  INTEGER  NELTS 

CHARACTER  CARRAY (NELTS)  *  (n) ,  CTEMP  *  (n) 

CHARACTER  ASSOC (NELTS)  *  (m) ,  CTEMPA  *  (m) 

CALL  CS0RT2D  (CARRAY,  NELTS,  CTEMP,  ASSOC,  CTEMPA) 

See  also  CSHUFL;  CSORT,  CSORTD;  CS0RT2*,  CSORTN,  CSORTND;  ISORTC, 
ISORTCD. 


***  Parameters  *** 

CALL  CSORT2D  (CARRAY,  NELTS,  CTEMP,  ASSOC,  CTEMPA) 

CARRAY  -  i/o  -  ch**  -  array  to  be  sorted 

NELTS  -  in  -  int  -  number  of  elements  to  be  sorted 

CTEMP  -  out  -  ch**  -  variable  of  the  same  length  as  CARRAY 

used  for  swapping 

ASSOC  -  i/o  -  ch**  -  associated  character  array  which  will 

be  re-ordered  to  maintain  a  l-to~l  corre¬ 
spondence  with  the  elements  of  CARRAY 

CTEMPA  -  out  -  ch**  -  variable  of  the  same  length  as  ASSOC 

used  for  swapping 

***  Example  *** 


Sort  (descending)  a  character  array  with  an  associated  character  array 

CHARACTER  CARRAY (3)  *  20  /  !  array  to  be  sorted 
A  'CASG...',  'AMDS...',  'CACR...'  / 

CHARACTER  ASS0C(3)  *  55  !  associated  array 

CHARACTER  WORK  *  55  !  work  element  for  the  sort  (must  be 

!  at  least  as  large  as  the  maximum  of 
!  the  length  of  CARRAY  and  the  length 
!  of  ASSOC) 

INTEGER  NELTS  /  3  /  !  number  of  records  to  ue  sorted 

CALL  CS0RT2D  (CARRAY,  NELTS,  WORK,  ASSOC,  WORK) 


After  the  sort,  CARRAY  will  contain  'CASG...',  'CACR...',  'AMDS...'; 
ASSOC  will  contain  the  corresponding  data. 
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****  CSORTD  **** 

Sort  (descending)  a  character  array. 

Usage:  INTEGER  NELTS 

CHARACTER  CARRAY (NELTS)  *  (n) ,  CTEMP  *  (n) 

CALL  CSORTD  (CARRAY,  NELTS,  CTEMP) 

See  also  CSHUFL;  CSORT;  CSORT2 ,  CSORT2D;  CSORTN,  CSORTND;  ISORTC, 
ISORTCD. 

***  Parameters  *** 

CALL  CSORTD  (CARRAY,  NELTS,  CTEMP) 

CARRAY  -  i/o  -  ch**  -  array  to  be  sorted 

NELTS  -  in  int  -  number  of  elements  to  be  sorted 

CTEMP  -  out  -  ch**  -  variable  of  the  same  length  as  CARRAY, 

used  for  swapping 


*** 


Example  *** 


Sort  a  character  array  into  descending  order. 


CHARACTER  CARRAY (3) 
A 

CHARACTER  WORK 


INTEGER  NELTS  /  3  / 


20  / 
20 


!  array  to  be  sorted 
'CASG...',  'AMDS...', 
!  work  element  for  the 
!  at  least  as  large  as 
!  SHORT) 

!  number  of  records  to 


1 CACR . . . '  / 
sort  (must  be 
the  length  of 

be  sorted 


CALL  CSORTD  (CARRAY,  NELTS,  WORK) 


After  the  sort,  CARRAY  will  contain  ’CASG...’,  ’CACR...1,  ’AMDS...1 
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****  CSORTN  **** 

Sort  (ascending)  a  character  array  having  an  associated  non-character 
array. 


Usage:  INTEGER  NELTS 

CHARACTER  CARRAY (NELTS)  *  (n) ,  CTEMP  *  (n) 
<non~character  type>  ASSOC (NELTS) 

CALL  CSORTN  (CARRAY,  NELTS,  CTEMP,  ASSOC) 

See  also  CSHUFL;  CSORT,  CSORTD;  CSORT2,  CSORT2D;  CSORTND;  ISORTC, 
ISORTCD. 


Parameters 


CALL  CSORTN  (CARRAY,  NELTS,  CTEMP,  ASSOC) 

CARRAY  -  i/o  -  ch**  -  array  to  be  sorted 

NELTS  -  in  -  int  -  number  of  elements  to  be  sorted 

CTEMP  -  out  -  ch**  -  variable  of  the  same  length  as  CARRAY, 

used  for  swapping 

ASSOC  -  i/o  -  -  associated  non-character  array  which  will 

be  re-ordered  to  maintain  a  1-to-l  corre¬ 
spondence  with  the  elements  of  CARRAY 


Example 


Sort  a  3-element  character*100  array  into  ascending  order  in  positions 
2-5.  An  associated  integer  array  contains  pointers  to  the  original 
position  in  an  array. 

(This  is  useful  if  you  have  long  records  to  sort  on  a  short  field. 
Instead  of  sorting  the  long  records,  extract  the  sort  field  into  another 
array  and  set  the  elements  of  the  associated  array  to  l..n.  Then  after 
sorting,  the  i~th  element  of  the  associated  array  will  point  to  the 
j  —  t h  element  of  the  long  record.) 


CHARACTER  L0NG(3)  *  100  /  !  sort  characters  2-5 
A  '.CASG...',  '.AMDS...',  '.CACR...'  / 

CHARACTER  SHORT (3)  *  4  !  array  to  hold  sort  field 

CHARACTER  WORK  *  4  !  work  element  for  the  sort  (must  be 

!  at  least  as  large  as  the  length  of 
!  SHORT) 
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INTEGER  POINTER (3)  !  associated  array  of  pointers 

INTEGER  N 

INTEGER  NELTS  /  3  /  !  number  of  records  to  be  sorted 

DO  110  N= 1 , NELT 

SHORT(N)  “  LONG(N) (2:5)  !  extract  sort  field 
POINTER (N)  -  N  !  set  up  pointer 

110  CONTINUE 

CALL  CSORTN  (SHORT,  NELTS,  WORK,  POINTER) 

After  the  sort,  SHORT  will  contain  'AMDS',  'CACR',  'CASG',  and 
1 ong  (pointer  (1) )  will  be  the  long  record  for  'AMDS',  etc. 
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****  CSORTND  **** 

Sort  (descending)  a  character  array  having  an  associated  non-character 
array. 

Usage:  INTEGER  NELTS 

CHARACTER  CARRAY (NELTS)  *  (n) ,  CTEMP  *  (n) 
<non~character  type*  ASSOC(NELTS) 

CALL  CSORTND  (CARRAY.  NELTS,  CTEMP,  ASSOC) 

See  also  CSHUFL;  CSORT,  CSORTD;  CS0RT2 ,  CS0RT2D;  CSORTN;  ISORTC, 
ISORTCD. 


Parameters 


CALL  CSORTND  (CARRAY,  NELTS,  CTEMP,  ASSOC) 


CARRAY  - 

i/o  - 

ch* 

NELTS  - 

in 

int 

CTEMP  - 

out  - 

ch* 

ASSOC  - 

i/o  - 

array  to  be  sorted 

number  of  elements  to  be  sorted 

variable  of  the  same  length  as  CARRAY, 
used  for  swapping 

associated  non-character  array  which  will 
be  re-ordered  to  maintain  a  l-to~l  corre¬ 
spondence  with  the  elements  of  CARRAY 


Example 


Sort  a  3-element  character’' 100  array  on  positions  2~5.  An  associated 
integer  array  contains  pointers  to  the  original  position  in  an  array. 

(This  is  useful  if  you  have  long  records  to  sort  on  a  short  field. 
Instead  of  sorting  the  long  records,  extract  the  sort  field  into  another 
array  and  set  the  elements  of  the  associated  array  to  l..n.  Then  after 
sorting,  the  i~th  element  of  the  associated  array  will  point  to  the 
j-th  element  of  the  long  record.) 


CHARACTER  LONG (3)  *  100  /  !  sort  characters  2-5 
A  ’ .CASG...',  '.AMDS...',  '.CACR...'  / 

CHARACTER  SHORT  (3)  *  A  !  array  to  hold  sort  field 

CHARACTER  WORK  *  4  !  work  element  for  the  sort  (must  be 

!  at  least  as  large  as  the  length  of 
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!  SHORT) 

INTEGER  POINTER(3)  !  associated  array  of  pointers 

INTEGER  N 

INTEGER  NELTS  /  3  /  !  number  of  records  to  be  sorted 

DO  110  N-l.NELT 

SHORT (N)  =  LONG(N)  (2:5)  !  extract  sort  field 

POINTER(N)  =  N  !  set  up  pointer 

110  CONTINUE 

CALL  CSORTND  (SHORT,  NELTS,  WORK,  POINTER) 

After  the  sort,  SHORT  will  contain  'CASG',  ' CACR ' ,  'AMDS',  and 
LONG (POINTER ( 1 ) )  will  be  the  long  record  for  'CASG',  etc. 
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****  DIGIT  **** 


Test  a  character  for  a  digit. 

Usage:  CHARACTER  *  1  CH 

LOGICAL  DIGIT 

IF  (DIGIT (CH))  THEN 


*** 


Parameters 


DIGIT  (CH) 


CH  -  in 

-  ch*l 

-  character  to 

be  tested 

DIGIT  -  out 

-  log 

-  TRUE  -  CH  is 
FALSE  -  CH  is 

a  digit 
not  a  digit 

***  Example  *** 

Read  a  character  string  and  flag  all  digits. 


CHARACTER  STRING  *  50,  FLAGS  *  50 
•  •  • 

FLAGS  =  '  ' 

READ  (*,  ’(A)')  STRING 
DO  110  N-1,50 

IF  (DIGIT  (STRING(N:N) ) )  FLAGS(NiN)  = 
110  CONTINUE 

PRINT  *,  STRING 
PRINT  *,  FLAGS 


Then,  for  STRING**  'abode  FGHIJ  kLmnO  pQRst  UvWxy  Z1234567890 () $ 
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***5*  DIGITS  **** 


Test  a  character  string  for  digits. 

Usage:  CHARACTER  *  (n)  STRING 

LOGICAL  DIGITS 

IF  (DIGITS (STRING))  THEN 


Parameters 


*** 


DIGITS  (STRING) 

STRING  -  in  ch**  -  string  to  be  tested 

DIGITS  -  out  -  log  -  TRUE  -  string  was  all  digits 

FALSE  -  string  was  not  all  digits 


***  Example  *** 

Read  a  character  string  and  test  for  all  digits. 


•  •  • 

CHARACTER  STRING  *  10 

READ  (*,  ’(A)')  STRING 
IF  (DIGITS  (STRING (N :N) ) )  THEN 

PRINT  *,  'The  string  is  all  digits.' 

ELSE 

PRINT  *,  'The  string  has  at  least  one  non-digit.' 
END  IF 


Then  for  STRING* ' 0123456789 ' ,  this  program  segment  prints: 
The  string  is  all  digits. 

For  STRING* ' abcde6ghij ' ,  this  program  segment  prints: 

The  string  has  at  least  one  non-digit. 
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i 


% 


t 


s 


FLP  BIT  **** 


Flip  one  bit  in  a  bit  array  (bit  string). 


Usage:  CALL  FLP  BIT  (BITNO.rl.r,  BITS.mv.r) 


See  also  CLR_BIT,  SET_BIT,  TST_BIT;  help  module  BIT_PKG. 


Parameters 


CALL  FLP_BIT  (BITNO.rl.r,  BITS.mv.r) 


BITNO  -  in  int  -  the  number  of  the  bit  to  be  flipped 


BITS  -  i/o  - 


-  the  bit  string  or  array 


Exampl e 


Flip  bit  76  in  a  100-bit  table: 


INTEGER  NBITS,  BITSWORD,  N_WORDS 
PARAMETER  (  BITSWORD  -  32  !  integer*4  word 

N  ,  NBITS  “  100  !  in  bit  array 

N  ,  N  WORDS  -  (NBITS  +  BITS_WORD  -  1)  /  BITSWORD 

)  ) 

INTEGER  BITNO,  TABLE (N  WORDS) 


BITNO  »  76 

CALL  FLP  BIT  (BITNO,  TABLE) 


***  Admin  info  *** 


Author : 


David  V.  Sommer  -  DTNSRDC  Code  1892.2 


Languages:  Fortran  77 


Date  written:  08/30/85 


Dates  revised 
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**** 


FRSTCH  **** 


Integer  function  to  return  the  position  of  the  first  non-blank  in  a  character 
string.  If  the  string  is  all  blanks,  0  (zero)  is  returned. 


Usage : 


CHARACTER  STRING  *  (n) 
INTEGER  FRSTCH 


NCHAR  =  FRSTCH  (STRING) 


it  "kit 


Parameters 


*** 


FRSTCH  (STRING) 

STRING  -  in 

FRSTCH  -  out  -  int  -  character  position  of  first  non-blank 


ch**  -  string  to  be  examined 


Example 


CHARACTER  LINE  *  80 
INTEGER  FLINE,  FRSTCH 


i 


READ  ' (A) ' ,  LINE 
FLINE  =  FRSTCH  (LINE) 

PRINT  *,  'The  line  starts  in  position  FLINE 
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****  GETSTR  **** 

Extract  character  string  according  to  user-defined  criteria. 

Usage:  CHARACTER  INSTR  *  (n) 

CHARACTER  OUTSTR  *  (n) 

CHARACTER  MATCH  *  (n) 

INTEGER  CODE,  GETSTR,  NCHAR 

NCHAR  -  GETSTR  (INSTR,  OUTSTR,  CODE,  MATCH) 


Parameters  *** 


GETSTR  (INSTR,  OUTSTR,  CODE,  MATCH) 


INSTR  -  in  -  ch**  -  the  input  string 
OUTSTR  -  out  -  ch**  -  the  output  string 


CODE  -  in  -  int  -  extrac 

1  - 
-1  - 
2  - 
-2  - 
3  - 
-3  - 
A  - 
-A  - 

5  - 
-5  - 

6  - 
-6  - 

MATCH  -  in  -  ch**  -  string 

(for 

string 

(for 

(Note: 


ion  criteria  -  one  of: 
alphanumeric  only 
alphanumeric  and  blank 
alphabetic  only 
alphabetic  and  blank 
numeric  only 
numeric  and  blank 
numeric  and  minus  ('-') 
numeric  and  minus  and  blank 
while  in  <match> 
while  not  in  <match> 
skip  while  in  <match> 
skip  while  not  in  <match> 

of  acceptable  characters 
<code>=5 | 6) 

of  unacceptable  characters 
<code>=*-5  |  -6) 

For  <code>= — A ! -3 | -2 ! -1 j 1 |2|3| A, 
use  '  ') 


GETSTR  -  out  -  out  -  will  contain  the  length  of  the 

extracted  or  skipped  string  -or- 
0  -  no  string 
-1  -  code  was  invalid 


*** 


Examples 


Art* 


GETSTR  (IN,  OUT,  CODE,  MATCH) 

1)  Extract  3  strings  from  a  "record".  The  first  string  is  alphanumeric 
(7  chars  max);  the  second  numeric  and  (3  chars  max);  the  third 


-mrr^w 


wm  ww  wa 


w 


■wp  vitf'*1 


86/05/30  VAX  NSRDC  GETSTR  Page  2-32 


everything  left  up  to  next  comma,  blank,  period  or  right  parenthesis. 

CHARACTER  RECORD*80,  FIRST*7,  SECOND*20,  THIRD*80 
INTEGER  CODE,  GETSTR,  Nl,  N2,  N3 


NEXT 

1 

Nl 

« 

GETSTR 

(RECORD (NEXT:)  , 

FIRST,  1, 

'  ') 

NEXT 

« 

NEXT  + 

Nl 

N2 

s= 

GETSTR 

(RECORD (NEXT:) , 

SECOND (1 : 

3),  A, 

'  ') 

NEXT 

« 

NEXT  + 

N2 

N3 

* 

GETSTR 

(RECORD (NEXT:) , 

THIRD,  -5 

,  \  •) 

') 

GETSTR  (IN, 

OUT,  CODE,  MATCH) 

2)  As  example 

1,  except  skip  leading 

blanks  for  each 

fiel 

CHARACTER  REC0RD*80,  FIRST*?, 

SECOND*20 

,  THIRD*80 

INTEGER  CODE, 

GETSTR,  Nl,  N2, 

N3 

NEXT 

* 

1 

NEXT 

= 

NEXT  + 

GETSTR  (RECORD (NEXT : ) ,  ' 

6,  ' 

’) 

Nl 

35 

GETSTR 

(RECORD (NEXT:) , 

FIRST,  1, 

'  ') 

NEXT 

* 

NEXT  + 

Nl 

NEXT 

- 

NEXT  + 

GETSTR  (RECORD (NEXT : ) ,  ’ 

’,  6,  ' 

’) 

N2 

* 

GETSTR 

(RECORD (NEXT:) , 

SECONDQ: 

3),  A, 

’  ') 

NEXT 

33 

NEXT  + 

N2 

NEXT 

* 

NEXT  + 

GETSTR  (RECORD (NEXT:) ,  ’ 

6,  ’ 

’) 

N3 

* 

GETSTR 

(RECORD (NEXT:)  , 

,  THIRD, 

-5,  ', 

.)  ') 

GETSTR  (IN,  OUT,  CODE,  MATCH) 

3)  Extract  5  comma-separated  parameters.  Note  that  the  last  parameter 
ends  with  a  blank  instead  of  a  comma. 

CHARACTER*80  RECORD,  STR1,  STR2 ,  STR3 ,  STRA,  STR5 


INTEGER 

.  CODE, 

GETSTR,  Nl,  N2, 

...,  N5 

NEXT 

1 

Nl 

= 

GETSTR 

(RECORD (NEXT:) , 

STR1 ,  -5, 

V) 

NEXT 

r= 

NEXT  + 

Nl  *  1 

N2 

SS 

GETSTR 

(RECORD (NEXT:) , 

STR2,  -5, 

V) 

N5 

- 

GETSTR 

(RECORD(NEXT : ) , 

STR5 ,  -5, 

’  ') 

***  Admin_info  *** 
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Date  written:  07/12/82 
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****  HMS2S  **** 

Convert  hh:mm:ss  to  seconds. 

Usage:  CHARACTER  *  (n)  HMS 

INTEGER  HMS2S ,  SEC 

SEC  =  HMS2S  (HMS) 

While  this  routine  is  normally  used  to  convert  standard-format  time 
(hh:mm:ss),  it  can  handle  almost  any  size  time  string  with  the  restriction 
that  only  digits,  minus  (only  allowed  as  the  first  non-blank  character), 
and  0-2  colons  (or  periods)  as  separators  are  allowed.  If  there  are  no 
colons,  the  entire  field  is  treated  as  seconds;  if  there  is  only  one  colon, 
then  mm:ss  is  assumed.  Each  of  the  up-to_three  subfields  may  be  any 
reasonable  length  or  omitted  (e.g.,  '1::'  is  the  same  as  '01:00:00'; 
whereas,  '1'  is  the  same  as  '00:00:01'). 

See  also  S2HMS  to  convert  back  to  hh:mm:ss  format. 


***  Parameters  ,r** 

HMS2S  (HMS) 

HMS  -  in  -  ch**  -  character  time  string  to  be  converted 

HMS2S  -  out  -  int  -  time  converted  to  seconds 

(If  HMS  is  invalid,  MAXINT  is  returned  (see 
HELP  @NSRDC  MAXINT).) 


Examples  **« 

1)  Convert  the  current  wall  clock  time  to  seconds. 

CHARACTER  NOW  *  8 
INTEGER  HMS2S ,  SEC 

CALL  TIME  (NOW) 

SEC  =  HMS2S  (NOW) 


2)  Subtract  3.5  hou 
ways  to  do  this. 


s  from  the  current 
This  assumes  that 


time.  Note  that 
the  current  time 


there  are  other 
is  after  3:30  am. 


'■’.v  y  -  \\ 


SSI 
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CHARACTER  NOW  *  8,  NEWTIM  *  8,  S2HMS  *  8 
INTEGER  HMS2S 
CALL  TIME  (NOW) 

NEWTIM  *  S2HMS  (HMS2S (NOW) -HMS2S ( ' 3 : 30: ' ) ) 


Admin  info 


*** 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 
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****  IOSTAT_TEXT  **** 

Convert  the  Fortran  I/O  status  code  to  a  message. 

Usage:  character  *  (c)  code 

character  *  1  level 

character  *  (m)  msg 

integer  iostat,  l_code,  l_msg 

open  (u,  fmt ,  IOSTAT'i ostat , . .  .  -or-  READ  (...  etc. 
if  (iostat  .ne.  0)  then  !  0  ==>  success 

call  iostat_text  (iostat,  level,  code,  l_ccde,  msg,  l_msg) 
print  *,  '%progname-'  //  level  //  //  code  ( : l_code)  // 

a  ',  '  //  msg ( : l_msg) 


Parameters 

call  iostat_text  (iostat,  level,  code,  l_code,  msg,  l_msg) 


iostat 

-  in 

-  integer  - 

I/O  status  from  Fortran  I/O  statement 

1  evel 

-  out 

-  char*l 

error  level  (S,  E,  F,  I,  W) 

code 

-  out 

-  char**  - 

capitalized  abbreviated  form  of  message 

l_code 

-  out 

-  integer  - 

length  of  code 

msg 

-  out 

-  char**  - 

text  of  message 

lmsg 

-  out 

-  integer  - 

length  of  msg 

Examples 


*** 


If  the  program  name  in  the  main  help  illustration  is  MYPROG  and  a 
"file  not  found"  condition  was  encountered  during  the  open,  the 
generated  message  would  be: 


•1MYPR0G-E-FILN0TF0U,  file  not  found 


***  Admin  info  *** 


Language : 
Author : 


DEC  VAX/VMS  Fortran  77 
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****  ISORTC  **** 

Sort  (ascending)  an  integer  array  having  an  associated  character  array. 

Usage:  INTEGER  NELTS,  IARRAY (NELTS) 

CHARACTER  CASSOC (NELTS)  *  (n) ,  CTEMPA  *  (n) 

CALL  ISORTC  (IARRAY,  NELTS,  CASSOC,  CTEMPA) 

See  also  CSHUFL;  CSORT,  CSORTD;  CSORT2,  CS0RT2D;  CSORTN,  CSORTND;  ISORTCD. 


***  Parameters  *** 
CALL  ISORTC  (IARRAY,  NELTS,  CASSOC,  CTEMPA) 


IARRAY  - 

i/o  - 

int 

-  array  to  be  sorted 

NELTS  - 

in 

int 

-  number  of  elements  to  be  sorted 

CASSOC  - 

i/o  - 

ch** 

-  associated  character  array  which  will  be 
re-ordered  to  maintain  a  l~to-l  corre¬ 
spondence  with  the  elements  of  IARRAY 

CTEMPA  - 

out  - 

ch** 

-  variable  of  the  same  length  as  CARRAY, 
used  for  swapping 

Example  *** 


Sort  a  10-element  integer  array  into  ascending  order.  There  is  an 
associated  character  array. 

INTEGER  NUM (10)  /  !  array  to  be  sorted 
A  4,  77,  12,  4,  99,  100,  88,  13,  123,  -5/ 

CHARACTER  CH(10)  *  23  !  associated  character  array 
CHARACTER  WORK  *  23  !  work  element  for  the  sort  (must  be  at 

!  least  as  large  as  the  length  of  CH) 

INTEGER  N 

INTEGER  NELTS  /  10  /  !  number  of  records  to  be  sorted 

CALL  ISORTC  (NUM,  NELTS,  WORK,  CH) 

After  the  sort,  NUM  will  contain  -5,  4,  4,  12,  13,  77,  88,  99,  100,  123. 
CH(i)  keeps  its  relationship  to  NUM(i) .  that  is,  CH(10)  after  the  sort  was 
CH(9)  before  the  sort. 
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****  ISORTCD  **** 

Sort  (descending)  an  integer  array  having  an  associated  character  array. 

Usage:  INTEGER  NELTS,  IARRAY (NELTS) 

CHARACTER  CASSOC (NELTS)  *  (n) ,  CTEMPA  *  (n) 

CALL  ISORTCD  (IARRAY,  NELTS.  CASSOC,  CTEMPA) 

See  also  CSHUFL;  CSORT,  CSORTD;  CS0RT2,  CSORT2D;  CSORTN,  CSORTND;  ISORTC. 


Parameters 

CALL  ISORTCD  (IARRAY,  NELTS,  CASSOC,  CTEMPA) 


IARRAY  - 

i/o  - 

int 

-  array  to  be  sorted 

NELTS  - 

in 

int 

-  number  of  elements  to  be  sorted 

CASSOC  - 

i/o  - 

ch** 

-  associated  character  array  which  will  be 
re-ordered  to  maintain  a  1-to-l  corre¬ 
spondence  with  the  elements  of  IARRAY 

CTEMPA  - 

out  - 

ch** 

-  variable  of  the  same  length  as  CARRAY, 
used  for  swapping 

Example 


Sort  a  10-element  integer  array  into  descending  order.  There  is  an 
associated  character  array. 


INTEGER  NUM(10)  /  !  array  to  be  sorted 
A  4,  77,  12,  4,  99,  100,  88,  13,  123,  -5/ 

CHARACTER  CH(10)  *  23  !  associated  character  array 
CHARACTER  WORK  *  23  !  work  element  for  the  sort  (must  be  at 

!  least  as  large  as  the  length  of  CH) 

INTEGER  N 

INTEGER  NELTS  /  10  /  !  number  of  records  to  be  sorted 

CALL  ISORTCD  (NUM,  NELTS,  WORK,  CH) 


After  the  sort,  NUM  will  contain  123,  100,  99,  88,  77,  13,  12,  4,  4,  -5. 
CH  ( i )  keeps  its  relationship  to  NUM(i),  that  is,  CH(1)  after  the  sort  was 
CH(9)  before  the  sort. 
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****  ISUM  **** 

Sum  an  integer  array. 

Usage:  INTEGER  NELTS,  IARRAY (KELTS) ,  ISUM,  TOTAL 

TOTAL  =  ISUM  (IARRAY,  NELTS) 

See  also  SUM. 

***  Parameters  *** 

ISUM  (IARRAY,  NELTS) 


IARRAY 

-  i/o  - 

int 

-  array  to  be  summed 

NELTS 

-  in 

int 

-  number  of  elements  to  be  summed 

ISUM 

-  out  - 

int 

-  the  sum 

Example 


Sum  a  10-element  integer  array. 

INTEGER  NUM (10)  /  !  array  to  be  summed 
A  4,  77,  12,  4,  99,  100,  88,  13,  123,  -5/ 

INTEGER  NELTS  /  10  /  !  number  of  records  to  be  summed 
INTEGER  ISUM,  TOTAL 

TOTAL  =  ISUM  (NUM,  NELTS) 


After  the  call,  TOTAL  will  contain  515. 
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IS  VT100  **** 


Determine  if  output  (SYSSOUTPUT)  is  VT- 100-compatible . 
Usage:  LOGICAL  IS_VT100,  VT100 

VT100  =  IS_VT100  () 

***  Parameters  *** 


IS_VT100  () 

IS_VT100  -  out  -  log  -  TRUE  -  output  file  is  VT-100-compatible 

FALSE  -  output  file  is  not  VT-100-compatible 


Examples  *** 


LOGICAL  IS_VT100 

IF  (IS_VT100  ())  THEN 

<fancy  output  for  a  VT-100  terminal> 

ELSE 

<regular  output  for  a  non-VT-100  terminal> 
END  IF 


Admin  info  *** 


Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  08/21/85 


Dates  revised 
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****  ITRANS  **** 

Integer  function  to  translate  characters  according  to  translate  tables  you 
specify  in  the  call. 

Usage:  CHARACTER  STRING  *  (nl) 

CHARACTER  FROM  *  (n2) 

CHARACTER  TO  *  (n2) 

INTEGER  ITRANS,  NTRANS 

NTRANS  =  ITRANS  (STRING,  FROM,  TO) 


*** 


Parameters 


ITRANS  (STRING, 

FROM, 

TO) 

STRING  - 

i/o  - 

ch** 

FROM 

in 

ch** 

TO 

in 

ch** 

ITRANS  - 

out  - 

int 

string  to  be  translated 

string  of  character  to  be  translated 

string  of  translation  characters 

will  contain  one  of: 

+n  -  the  number  of  characters 
translated 

0  -  no  translation  done 
-1  -  no  translation  done  because 
LEN (FROM)  <>  LEN (TO) 


Remarks:  Each  occurrence  of  FROM(i : i)  in  string  is  changed  to  T0(i:i). 

See  also  subroutine  TRANS. 


Example  *** 


CHARACTER  LINE  *  20 

CHARACTER  FROM  *  26  /  ' abcdefghi jklmnopqrstuvwxyz' / 
CHARACTER  TO  *  26  /  ' ABCDEFGHI JKLMNOPQRSTUVWXYZ ' / 

INTEGER  ITRANS,  NTRANS 

READ  ' (A) ’ ,  LINE 

NTRANS  -  ITRANS  (LINE,  FROM,  TO) 

Assuming  that  the  line  read  contains  'John  &  Mary  User',  then  LINE 
becomes  'JOHN  L  MARY  USER'  and  NTRANS  -  9. 
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****  JGDATE  **** 

Convert  any  Gregorian  date  to  a  relative  Julian  number  or  vice  versa. 

Usage:  INTEGER  JG,  JD,  GYEAR ,  GMONTH ,  GDAY 

CALL  JGDATE  (JG,  JD,  GYEAR,  GMONTH,  GDAY) 

The  relative  Julian  nubmer  corresponding  to  a  Gregorian  date  is  the 
number  of  days  since  11/24/-4713  (extrapolating  the  Gregorian  calendar). 

This  subroutine  is  useful  in  determining  the  elapsed  number  of  days 
betweeen  any  two  calendar  dates.  It  can  also  be  used  to  find  the 
calendar  date  so  many  days  from  any  given  date. 


Parameters  *** 


CALL  JGDATE  (JG,  JD,  GYEAR,  GMONTH,  GDAY) 


JG  -  in  int  -  direction  of  conversion 

1  -  Gregorian  to  Relative  Julian 

2  -  Relative  Julian  to  Gregorian 


JG=1:  JD  -  out 
GYEAR  -  in 
GMONTH  -  in 
GDAY  -  in 


int  -  will  contain  relative  Julian  number 

int  -  Gregorian  year  (e.g.,  .985) 

int  -  Gregorian  month  (1-12) 

int  -  Gregorian  day  (1-31) 


JG«2:  JD  -  in 
GYEAR  -  out 
GMONTH  -  out 
GDAY  -  out 


int  -  relative  Julian  number 

int  -  will  contain  Gregorian  year  (e.g.,  1985) 
int  -  will  contain  Gregorian  month  (1-12) 
int  -  will  contain  Gregorian  day  (1-31) 


Example 


*** 


INTEGER  JD,  GY,  GM,  GD 

CALL  JDDATE  (1,  JD,  1985,  2,  25) 
JD  -  JD  +  1000 

CALL  JGDATE  (2,  JD,  GY,  GM  ,GD) 


This  example  will  find  the  date  1000  days  from  02/25/85. 
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****  JP_MODE  **** 

Get  the  job/process  mode  (batch,  interactive,  network,  other,  or  unknown). 
Usage:  CHARACTER  *  11  JP_M0DE,  MODE 

MODE  =  JP  MODE  () 


Parameters 


JP_MODE  () 

JP_MODE  -  out  -  ch**  -  one  of:  'BATCH',  'INTERACTIVE',  'NETWORK', 

’OTHER',  or  ’UNKNOWN’ 


***  Examples  *** 

CHARACTER  *  11  JP_MODE,  MODE 

MODE  »  JP+MODE  () 

IF  (MODE  .EQ.  'BATCH')  THEN 
<do  batch-only  stu£f> 

ELSE  IF  (MODE  .EQ.  'INTERACTIVE')  THEN 
<do  interactive-only  stu£f> 

ELSE  IF  (MODE  .EQ.  'NETWORK')  THEN 
<do  network-only  stuff> 

ELSE 

<do  other | unknown-only  stuff > 

END  IF 


rtrt* 


Admin  info  *** 


Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 


Date  written:  08/21/85 
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*5r?v*  LEFT  **** 

Integer  function  to  left-justify  a  character  string.  The  string  is  left- 
justified  within  itself. 

Usage:  CHARACTER  STRING  *  (n) 

CHARACTER  WORK  *  (n) 

INTEGER  LEFT,  LSTRING 

LSTRING  «  LEFT  (STRING,  WORK) 


*** 


Parameters 


*** 


LEFT  (STRING,  WORK) 

STRING  -  i/o  -  ch**  -  string  to  be  left- justified 

WORK  -  -  ch**  -  work  variable  of  len(string) 

LEFT  -  out  -  int  -  the  position  of  the  last  non-blank 


Example  *** 


CHARACTER  LINE  *  80 
CHARACTER  WORK  *  80 
INTEGER  LEFT,  LLINE 
«  •  • 

READ  ' (A) ' ,  LINE 

LLEFT  =  LEFT  (LINE,  WORK) 

If  LINE  contains  '  Some  words  ',  then  after  left  justifying,  it 

will  contain  'Some  words  ',  and  LLINE  *  10. 

1 ...  5. .. 10. .. 15  ...  20 
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****  L02UP  **** 

Convert  lower  case  to  upper  case.  Non-alphabet ic  characters  are  not 
changed. 

Usage:  CHARACTER  STRING  *  (n) 

CALL  L02UP  (STRING) 


*** 


Parameter 


*** 


CALL  L02UP  (STRING) 

STRING  -  i/o  -  ch,v*  -  string  to  be  translated  in  place 


***  Examples  *** 

If  STRING  contains 

' AbCdEf GhI jKIMnOpQrStUvWxYz ' 
then  after  CALL  L02UP  (STRING),  STRING  will  contain 
' ABCDEFGHI JKLMNOPQRSTUVWXYZ ' 


'.“V.VA'JV’A  -j 
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****  LOWER  **** 
Test  a  character  for  lower  case  letter. 


Usage:  CHARACTER  *  1  CH 

LOGICAL  LOWER 

IF  (LOWER (CH))  THEN 


***  Parameters  *** 

CH  -  in  -  ch*l  -  character  to  be  tested 

LOWER  -  out  “  log  -  TRUE  -  CH  is  a  lower  case  letter 

FALSE  -  CH  is  not  a  lower  case  letter 


Example 


*** 


Read  a  character  string  and  flag  all  lower  case  letters. 


•  •  • 

CHARACTER  STRING  *  50,  FLAGS  *  50 
FLAGS  =  '  ' 

READ  (*,  '(A)')  STRING 
DO  110  N=1 , 50 

IF  (LOWER  (STRING  (N:N) ) )  FLAGS(N-.N)  -  ,a’ 
110  CONTINUE 

PRINT  *,  STRING 
PRINT  *,  FLAGS 


Then, 


for  string** ' abcde  FGHIJ  kLranO  pQRst  UvWxy  Z 1234567890 () $ 


flags 


x  »  A  A  A  A  A 


A  A  A 


A  A  A  AAA 
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****  LSTCH  **** 

Integer  function  to  return  the  position  of  the  last  non-blank  in  a  character 
string.  If  the  string  is  all  blanks,  0  (zero)  is  returned. 

Usage:  CHARACTER  STRING  *  (n) 

INTEGER  LSTCH 

NCHAR  -  LSTCH  (STRING) 


Parameters 


*** 


LSTCH  (STRING) 

STRING  -  in  ch,v*  -  string  to  be  examined 

LSTCH  -  out  -  int  -  character  position  of  last  non-blarrk 

***  Example  *** 

CHARACTER  LINE  *  80 
INTEGER  LLINE ,  LSTCH 

READ  ' (A) ' ,  LINE 
LLINE  -  LSTCH  (LINE) 

PRINT  *,  'The  line  is 


LLINE,  '  characters  long. ' 
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K: 


*■**  MAXAI  **** 

Find  the  maximum  of  an  array  of  integers. 

Usage:  INTEGER  ARRAY (n) ,  NELTS,  MAXAI,  MAX_VALUE 

MAX_VALUE  =  MAXAI  (ARRAY,  NELTS) 

See  also  MAXAR,  MINAI ,  MINAR. 


***  Parameters 

MAXAI  (ARRAY,  NELTS) 


ARRAY  - 

in 

-  int 

-  array  of  integers 

to  be  analyzed 

NELTS  - 

in 

-  int 

-  number  of  elements 

in  array 

MAXAI  - 

out 

-  int 

-  the  maximum  value 

in  array 

***  Examples  *** 


PROGRAM  TEST 
IMPLICIT  NONE 

INTEGER  ARRAY (4)  /  -23,  0,  473,  472/ 

INTEGER  MAXAI 
INTEGER  NELTS  /  4/ 

TYPE  *,  'The  maximum  value  is  ',  MAXAI  (ARRAY,  NELTS) 
END 

This  will  produce  the  output: 

The  maximum  value  is  473 


Admin  info  *** 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  07/10/85 
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****  MAXAR  **** 

Find  the  maximum  of  an  array  of  real  numbers. 

Usage:  INTEGER  NELTS 

REAL  ARRAY tn),  MAXAI ,  MAX_VALUE 

MAX_VALUE  =  MAXAR  (ARRAY,  NELTS) 

See  also  MAXAI,  MINAI ,  MAXAI. 


Parameters 

MAXAR  (ARRAY,  NELTS) 


ARRAY  - 

in 

-  real 

-  array  of  real  numbers 

to  be  analyzed 

NELTS  - 

in 

-  int 

-  number  of  elements  in 

array 

MAXAR  - 

out 

-  real 

-  the  maximum  value  in 

array 

*** 


Examples 


*** 


PROGRAM  TEST 
IMPLICIT  NONE 

REAL  ARRAY (4)  /  -23.,  0.,  473.,  472.9/ 

REAL  MAXAR 
INTEGER  NELTS  /  4/ 

TYPE  *,  'The  maximum  value  is  ',  MAXAR  (ARRAY,  NELTS) 
END 

This  will  produce  the  output: 

The  maximum  value  is  473.0000 


Admin  info  **’■ 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  07/10/85 
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****  MAXINT  **** 

Return  the  maximum  integer  supported  by  VAX/VMS. 

Usage:  INTEGER  MAXINT,  VALU 

VALU  =  MAXINT  () 

See  also  MININT  to  obtain  the  maximum  negative  integer. 


*  *  * 


Parameter 


MAXINT  () 

MAXINT  -  out  -  int  -  the  maximum  integer  supported  by  VAX/VMS 


*** 


Example 


*** 


Find  the  minimum  value  in  an  array  of  integers. 

INTEGER  FUNCTION  MIN_ARRAY  (ARRAY,  N_ARRAY) 
INTEGER  ARRAY  (*) ,  N_ARRAY 
INTEGER  MAXINT,  N 
MIN_ARRAY  =  MAXINT  () 

DO  N«1,N_ARRAY 

MIN_ARRAY  =  MIN  (MIN_ARRAY,  ARRAY (N) ) 

END  DO 
RETURN 
END 


Admin  info  *** 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  07/08/85 


Dates  revised 
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****  MAXREAL  **** 

Return  the  maximum  real  number  supported  by  VAX/VMS 
Usage:  REAL  MAXREAL,  VALU 

VALU  =  MAXREAL  () 

See  also  MINREAL  to  obtain  the  smallest  absolute  real  number. 


***  Parameter  *** 

MAXREAL  () 

MAXREAL  -  out  -  int  -  the  maximum  real  number  supported  by  VAX/VMS 


*** 


Example 


Find  the  minimum  value  in  an  array  of  real  numbers. 


REAL  FUNCTION  MIN_ARRAY  (ARRAY,  N  ARRAY) 
REAL  ARRAY  (*) ,  MIN_ARRAY 
INTEGER  N,  NARRAY 
MIN_ARRAY  «  MAXREAL  () 

DO  N= 1 , N_ARRAY 

MIN_ARRAY  -  MIN  (MIN_ARRAY,  ARRAY (N) ) 
END  DO 
RETURN 
END 


***  Admin  info  *** 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  07/10/85 
Dates  revised 


'A. 
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****  MFRAME  **** 

Obtain  the  machine  and  node  on  which  the  program  is  running. 
Usage:  CHARACTER  CPU  *  10,  NODE  *  3 

CALL  MFRAME  (CPU,  NODE) 


Parameters 


*** 


CALL  MFRAME 

(CPU, 

NODE) 

CPU 

-  out 

1 

-V 

> 

JZ 

o 

i 

NODE 

-  out 

-  ch**  - 

the  machine  (always  ' VAXcluster ' ) 
the  node  ('DTI'  or  ' DT2 ' ) 


Example  *** 


CHARACTER  CPU  *  10,  NODE  *  3 
CALL  MFRAME  (CPU,  NODE) 

TYPE  *,  'This  program  is  running  on  node  ',  NODE, 

'  of  the  ' ,  CPU,  ' . ' 

will  type:  This  program  is  running  on  node  DTn  of  the  VAXcluster 
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****  MINAI  **** 

Find  the  minimum  of  an  array  of  integers. 

Usage:  INTEGER  ARRAY (N) ,  nelts,  MINAI,  MIN_VALUE 

MIN_VALUE  =  MINAI  (ARRAY,  NELTS) 

See  also  MAXAR,  MAXAI ,  MINAR . 


Parameters 

MINAI  (ARRAY,  NELTS) 


ARRAY  -  in 

“  int 

-  array  of  integers  to 

be  analyzed 

NELTS  -  in 

“  int 

-  number  of  elements  in 

array 

MINAI  -  out 

-  int 

-  the  minimum  value  in 

array 

Examples 


PROGRAM  TEST 
IMPLICIT  NONE 

INTEGER  ARRAY (4)  /  -23,  0,  473,  472/ 

DTEGER  MINAI 
II’TEGER  NELTS  /  4/ 

TY7E  *,  'The  minimum  value  is  ',  MINAI  (ARRAY,  NELTS) 
ENL 

This  will  produce  the  output: 

The  minimum  value  is  -23 


Admin  info 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 
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Date  written:  07/10/85 


86/05/30 


VAX 


NSRDC 


MINAR 


Page  2-55 


****  MINAR  **** 

Find  Che  minimum  of  an  array  of  real  numbers. 

Usage:  INTEGER  NELTS 

REAL  ARRAY (n),  MINAI ,  MIN_VALUE 

MIN_VALUE  =  MINAR  (ARRAY,  NELTS) 

See  also  MAXAl,  MAXAR,  MINAI. 

***  Parameters  *** 

MINAR  (ARRAY,  NELTS) 

ARRAY  -  in  real  -  array  of  real  numbers  to  be  analyzed 

NELTS  -  in  int  -  number  of  elements  in  array 

MINAR  -  out  -  real  -  the  minimum  value  in  array 

***  Examples  *** 

PROGRAM  TEST 
IMPLICIT  NONE 

REAL  ARRAY(A)  /  -23.,  0.,  473.,  472.9/ 

REAL  MINAR 
INTEGER  NELTS  /  4/ 

TYPE  *,  ’The  minimum  value  is  MINAR  (ARRAY,  NELTS) 

END 

This  will  produce  the  output: 

The  minimum  value  is  -23.0000 

***  Admin  info  *** 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 


Date  written:  07/10/85 
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****  MININT  **** 

Return  the  maximum  negative  integer  supported  by  VAX/VMS. 

Usage:  INTEGER  MININT,  VALU 

VALU  =  MININT  () 

See  also  MAXINT  to  obtain  the  maximum  positive  integer. 


it  it  it 


Parameter 


it  ?V  it 


MININT  () 

MININT  -  out  ~  int  “  the  minimum  integer  supported  by  VAX/VMS 


Example  *** 


Find  the  maximum  value  in  an  array  of  integers. 

INTEGER  FUNCTION  MAXARRAY  (ARRAY,  N  ARRAY) 
INTEGER  ARRAY  (*) ,  NARRAY 
INTEGER  MININT,  N 
MAX_ ARRAY  -  MININT  () 

DO  N=1,N_ARRAY 

MAXARRAY  =  MAX  (MAXARRAY,  ARRAY (N)) 
END  DO 
RETURN 
END 


***  Admin_inf o  '  *** 

Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  07/08/85 


Dates  revised 
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****  MINREAL  **** 

Return  the  minimum  real  number  (absolute  value)  supported  by  VAX/VMS. 

Usage:  REAL  MINREAL,  VALU 

•  •  • 

VALU  «  MINREAL  () 

See  also  MAXREAL  to  obtain  the  largest  absolute  real  number. 


Parameter 


Vr  it  it 


MINREAL  () 

MINREAL  -  out  -  int  -  the  minimum  real  number  (absolute  value) 

supported  by  VAX/VMS 


Example  *** 


Find  the  maximum  value  in  an  array  of  positive,  non-zero  real  numbers. 

REAL  FUNCTION  MAX_POS  ARRAY  (ARRAY,  NARRAY) 

REAL  ARRAY  (*) ,  MAX_ ARRAY 
INTEGER  N,  N_ARRAY 
MAX_ARRAY  =  MINREAL  () 

DO  N= 1 , N_ARRAY 

MAX_ARRAY  =  MIN  (MAXARRAY ,  ARRAY (N) ) 

END  DO 
RETURN 
END 


Admin  info  *** 


Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 


* 

< 


a 


t 


Date  written:  07/10/85 
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****  MOVEIT  **** 


Move  an  array. 


Usage:  REAL  FROM,  TO 

INTEGER  NWORDS 


-or-  INTEGER  FROM,  TO 


CALL  MOVEIT  (FROM,  TO,  NWORDS) 


Parameters 


CALL  MOVEIT  (FROM,  TO,  NWORDS) 


FROM  -  in  -  real/int  -  array  to  be  moved 


-  out  -  real/int  -  output  array 


NWORDS  -  in  -  int 


-  number  of  words  to  be  moved 


Examples 


Save  a  100-word  integer  array  A  in  A_SAVE: 


INTEGER  A(100),  A  SAVE(IOO) 


CALL  MOVEIT  (A,  A  SAVE,  100) 


*  Admin  info  *** 


Language:  Fortran  77 


Author : 


David  V.  Sommer  -  DTNSRDC  Code  1892.2 


Date  written:  10/16/79 


Dates  revised 


-77 
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****  NARGS  **** 

In  a  subprogram,  get  the  number  of  arguments  in  the  call. 


Usage:  SUBROUTINE  SUB  (<args>) 

INTEGER  NARGS,  NOARGS 
NOARGS  =  NARGS  ()  -or- 


CALL  NARGS  (NOARGS) 


■ k  it  it 


Parameters 


it  it  it 


NOARGS  =  NARGS  () 

CALL  NARGS  (NOARGS) 

NARGS  -  out  -  int  -  number  of  arguments  in  the  actual  call  to 

the  subprogram 

NOARGS  -  out  -  int  -  same  as  NARGS 


it  it  it 


Example 


it  it  it 


NOARGS  -  NARGS  () 

CALL  NARGS  (NOARGS) 

PROGRAM  TEST  SUBROUTINE  SUB  (Al ,  A2,  A3,  A4,  A5,  A6) 

INTEGER  NARGS,  NOARGS 

CALL  SUB  (ARG1,  ARG2 ,  ARG3)  NOARGS  -  NARGS  () 

TYPE  *,  'Called  with  ',  NOARGS,  '  arguments.' 

END 

RETURN 

END 

In  this  example,  the  output  will  be: 

Called  with  3  arguments. 


it  it  it 


Auu..n  info  *** 


Language:  MACRO 

Author:  F.  Nagy  -  Fermilab  Accelerator  Control  System  -  ACNET 

Date  written:  06/07/82 
Dates  revised 

06/08/82  -  04/15/83  -  09/02/83  -  10/19/84 
08/16/85  -  LIB_  removed  from  start  of  routine  name 
-  added  to  NSRDC. OLB  at  DTNSRDC 


* 


<U£i 
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iticlrit  PARS  **** 


Parse  a  string. 


Usage:  CHARACTER  *  (np)  PARSCH 

CHARACTER  *  (n)  STRING,  PARAM (<maxpar>) 

INTEGER  MAXPAR,  NPARS ,  PARS 

NPARS  =  PARS  (PARSCH,  STRING,  PAR AM,  MAXPAR) 


See  also  QUAL_CHAR ,  QUAL_INT,  QUAL_LOG. 


*** 


*** 


Parameters 
PARS  (PARSCH,  STRING,  PARAM,  MAXPAR) 

PARSCH  -  in  ch**  -  delimiter(s) 

STRING  -  in  ch**  -  character  string  to  be  parsed 

PARAM  -  out  -  ch**  -  character  array  to  hold  the  fields 

MAXPAR  -  in  int  -  maximum  number  of  fields  to  extract 

The  delimiters  of  the  fields  are  PARSCH  and  a  space.  When  found, 
PARSCH  (if  other  than  a  space)  is  returned  as  the  first  character  of 
the  field. 


*** 


Example 


It  Irk 


Read  a  filename  and  some  qualifiers  and  parse  them.  The  qualifiers 
start  with  a  slash  (/) . 

CHARACTER  *  256  STRING,  PARAM (10) 

INTEGER  N,  NPARS,  PARS 

TYPE  *,  'File?' 

ACCEPT  1,  STRING 
1  FORMAT  (A) 

NPARS  =  PARS  ('/',  STRING,  PARAM,  10) 

TYPE  *,  ' npars= ' ,  NPARS 
DO  110  N-l, NPARS 

TYPE  *,  ' param  (  ’ ,  N,  PARAM (N) 

110  CONTINUE 


If  the  response  to  'File?'  is 

/NOCC  MYFILE/NOSKIP  /HEADER  /LENGTH*66 


'o  k'  ■ " '  ■  ‘  ■  ■  •  * 
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then  after  the  call  to  PARS: 


NPARS  -  5 
PAR  AM  (1) 
PAR AM (2) 
PARAMO) 
PAR  AM  (4) 
PAR  AM  (5) 


/NOCC 

MYFILE 

/NOSKIP 

/HEADERCC 

/LENGTH-66 


(These  are  the  defaults  for  the  AUXPRINT  command.) 


Admin  info  *** 


Language:  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  02/06/85 
Dates  revised 

08/08/85  -  move  to  library  NSRDC 
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****  PARSE_FI LESPEC  **** 

Parse  a  file  specification,  that  is,  break  it  up  into  it's  components. 

Usage:  CHARACTER  *  (n)  FILESPEC 

INTEGER  LFILESPEC 
INTEGER  NODE1 ,  NODE2 
INTEGER  DEVICE1 ,  DEVICE2 
INTEGER  DIRECTORY1 ,  DIRECTORY2 
INTEGER  FILENAME1 ,  FILENAME2 
INTEGER  FILETYPE1 ,  FILETYPE2 
INTEGER  VERSION1 ,  VERSI0N2 

CALL  PAR SE_F I LESPEC  (FILESPEC  , 

A  NODEl 

B  DEVICE1 

C  DIRECTORY1 , 

D  FILENAME1  , 

E  FILETYPE1  , 

F  VERSION1  , 

This  subroutine  returns  pointers  to  the  beginning  and  end  of  each 
component.  For  example,  FILESPEC (FILETYPE1 : FILETYPE2)  is  the  type 
component.  If  a  component  is  missing,  the  pointers  are  set  to  zero. 
The  length  of  the  file  specification  is  also  returned.  No  attempt 
is  made  to  validate  the  components. 


LFILESPEC  , 
NODE2 
DEVICE2 
DIRECTORY2, 
FILENAME2  , 
F1LETYPE2  , 
VERSION2  ) 


***  Parameters  *** 
CALL  PARSE  FILESPEC  (FILESPEC  ,  LFILESPEC  , 


A 

NODEl  ,  NODE 2 

B 

DEVICE1  ,  DEVICE2 

C 

DIRECTORYl ,  DIRECTORY2 , 

D 

FILENAHE1  ,  FILENAME2  , 

E 

FILETYPE1  ,  FILETYPE2  , 

F 

VERSIONl  ,  VERSION2  ) 

FILESPEC 

in 

ch** 

-  file  specification 

to  be  pars 

LFILESPEC  - 

out  _ 

int 

-  length  of  ! 

Eilespec 

NODEl 

out  - 

int 

-  pointer 

to 

start 

of 

node 

NODE2 

out  - 

int 

-  pointer 

to 

end 

of 

node 

DEVICE1 

out  - 

int 

-  pointer 

to 

start 

of 

device 

DEVICE2 

out  “ 

int 

-  pointer 

to 

end 

of 

device 

DIRECTORYl  - 

out  " 

int 

-  pointer 

to 

start 

of 

directory 

DIRECTORY2  - 

out  - 

int 

-  pointer 

to 

end 

of 

directory 

FILENAME1  - 

out  ~ 

int 

-  pointer 

to 

start 

of 

file  name 

FILENAME2  - 

out  ~ 

int 

-  pointer 

to 

end 

of 

file  name 
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FILETYPEl 

-  out  ~  int 

-  pointer 

to 

start 

of 

file  type 

FILETYPE2 

-  out  -  mt 

-  pointer 

to 

end 

of 

file  type 

VERSIONl 

-  out  -  int 

-  pointer 

to 

start 

of 

version 

VERSI0N2 

-  out  -  int 

-  pointer 

to 

end 

of 

version 

***  Examples  * 
CALL  PARSE  FILESPEC  (FILESPEC  ,  LFILESPEC 


N0DE1  ,  N0DE2 
DEVICE1  ,  DEVICE2 
DIRECTORY  1,  DIRECT0RY2 , 
FILENAMEl  ,  FILENAME2  , 
FILETYPEl  ,  FILETYPE2  , 
VERSIONl  ,  VERSI0N2  ) 


If  filespec  contains  "MYFILE.TYP",  then  after  the  call, 

1 ...  5 ...  10 

LFILESPEC  -  10 

N0DE1  =  N0DE2  =  DEVICE1  »  DEVICE2  -  DIRECTORYl  =  DIRECT0RY2 
FILENAMEl  =  1  FILENAME2  -  6 

FILETYPEl  =  8  FILETYPE2  -  10 

VERSIONl  =  VERSI0N2  =  0 


If  filespec  contains  "USERDISKl : [MYID. J0N1234567890]MYFILE.TYP;24’\ 

1 ...  5 ...  10 ...  15 ...  20 ...  25 ...  30 ...  35 ...  40. A3 

then  after  the  call, 

LFILESPEC  -  43 
NODEl  -  NODE2  =  0 

DEVICE1  -  1  DEVICE2  -  10 


FILETYPEl 


1 

DEVICE2  -  10 

m 

■1 

11 

DIRECT0RY2  =  30 

I 

31 

FILENAME2  *  36 

J 

J> 

38 

FILETYPE2  -  40 

hr 

n 

42 

VERSI0N2  -  43 

S 
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****  QUAL_CHAR  **** 

Get  the  value  of  a  character  qualifier  (/qual*s tring) . 

Usage:  CHARACTER  QUAL  FIELD  *  (nf) ,  QUAl_VALUE  *  (nv) 

CHARACTER  QUAL~NAME  *  (nn) ,  DEFAULT  *  (nd) 

CHARACTER  WORK_FIELD  *  (nf) ,  W0RK_NAME  *  (nn) 

INTEGER  MINCH 
LOGICAL  QUAL_CHAR 
•  •  # 

IF  (QUAL_CHAR  (QUAL_NAME ,  W0RK_NAME,  MINCH,  DEFAULT, 

QUAL_FIELD,  WORK  FIELD,  QUAL  VALUE))  THEN 


See  also  QUAL_INT,  QUAL_L0G,  PARS. 


Parameters 


QUAL_CHAR  (QUAL_NAME,  WORK_NAME,  MINCH,  DEFAULT,  QUAL_FIELD, 
WORK_FIELD,  QUAL_ VALUE) 

QUAL_NAME  -  in  -  ch**  -  qualifier  name  (e.g.,  '/QUAL') 

WORK_NAME  -  scr  -  ch**  -  work  variable  of  length  >*  LEN (QUAL  NAME) 

MINCH  -  in  -  int  -  minimum  number  of  characters  to  be  tested 

(if  MINCH- 1,  then  /Q,  /QU,  /QUA  and  /QUAL 
are  recognized) 


DEFAULT 

QUAL_FIELD 

WORKFIELD 

QUAL_VALUE 

QUAL_CHAR 


in 

-  ch** 

in 

-  ch** 

scr 

-  ch** 

out 

-  ch** 

out 

-  log 

default  value  if  only  '/QUAL'  or  '/QUAL=' 

field  to  be  checked  and  evaluated 

work  variable  of  length  >=  LEN (QUAL_FIELD) 

returned  value  of  ' /QUAL-value ' 

TRUE  -  QUAL_FIELD  was  QUAL_NAME  and  a  value 
has  been  returned 

FALSE  -  QUAL_FIELD  is  not  QUAL_NAME  and  no 
value  is  returned 


***  Example  *** 

QUAL_CHAR  (QUAL_NAME,  W0RK_NAME,  MINCH,  DEFAULT,  QUAL_FIELD, 
W0RK_FIELD,  QUAL_VALUE) 


After  extracting  the  qualifier,  see  if  it  is  /TYPE=type.  If  it  is, 
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QUAL_VALUE  will  contain  'type'. 

CHARACTER  *  15  QUAL_FIELD,  QUAL_VALUE,  WORK_NAME 
LOGICAL  QUAL_CHAR 

IF  (QUAL_CHAR  ('/TYPE',  WORK_NAME,  1,  'deftype',  QUAL_FIELD, 
&  WORK_NAME,  QUAL_VALUE) )  THEN 

<the  qualifier  was  TYPE1* 

ELSE 

<the  qualifier  was  not  TYPE5, 

END  if 


Admin  info  *** 


Language:  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  03/27/85 

Dates  revised 
05/15/85  -  ? 

08/07/85  -  change  name  from  getqulc  to  qual_char 

-  generalize  by  adding  work_name  and  work_field  parameters 

-  move  to  library  NSRDC 
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**** 

QUAL  INT 

**** 

Get  the  value  of  an  integer  qualifier  (/qual=integer) . 

Usage:  CHARACTER  QUAL_FIELD  *  (nf) ,  QUAL_NAME  *  (nn) 

CHARACTER  WORK_FIELD  *  (nf) ,  WORK  NAME  *  (nn) 

INTEGER  DEFAULT,  MINCH,  QUAL_VALUE 
LOGICAL  QUAL_INT 

IF  (QUAL_INT  (QUAL_NAME ,  W0RK_NAME,  MINCH,  DEFAULT, 

QUAL_FIELD,  W0RK_FIELD,  QUAL_VALUE) )  THEN 


See  also  QUAL_CHAR ,  QUAL_LOG,  PARS. 


*  *  * 


Parameters 


*** 


QUAL_INT  (QUAL 
WORK' 


NAME,  WORK_NAME,  MINCH,  DEFAULT,  QUALJFIELD, 
FIELD,  QUAL  VALUE) 


QUAL_NAME  - 

in  -  ch** 

W0RK_NAME  - 

scr  -  ch** 

MINCH 

in  -  int 

DEFAULT 

in  -  int 

QUAL_FIELD  - 

in  -  ch** 

WORKFIELD  - 

scr  -  ch** 

QUAL_VALUE  - 

out  -  int 

QUAL_INT 

out  -  log 

(if  MINCH-1,  then  /Q,  /QU,  /QUA  and  /QUAL 
are  recognized) 


has  been  returned 

FALSE  -  QUAL_FIELD  is  not  QUAL_NAME  and  no 
value  is  returned 


***  Example  *** 

QUAL_INT  (QUAL_NaME,  WORK_NAME ,  MINCH,  DEFAULT,  QUAL_FIELD, 

WORK_FIELD,  QUAL_VALUE) 

After  extracting  the  qualifier,  see  if  it  is  /LENGTH* 1 ength .  If  it  is, 
QUAL_VALUE  will  contain  <length>  as  an  integer. 
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CHARACTER  *  15  QUAL_FIELD, 
CHARACTER  *  7  WORK_NAME 

INTEGER  QUAL_VALUE 
LOGICAL  QUAL  I NT 


WORK  FIELD 


IF  (QUAL_INT  ('/LENGTH',  WORK_NAME ,  1,  66,  QUAL_FIELD, 
&  WORK_FIELD,  QUAL_VALUE) )  THEN 

<the  qualifier  was  LENGTH* 

ELSE 

<the  qualifier  was  not  LENGTH> 

END  IF 


Admin  info 


*  Vc 


Language : 
Author : 

Date  written: 


VAX/VMS  Fortran  77 

David  V.  Sommer  -  DTNSRDC  Code  1892.2 
03/27/85 


Dates  revised 
05/15/85  -  ? 

08/07/85  -  change  name  from  getqulc  to  qual_char 

-  generalize  by  adding  work_name  and  work_field  parameters 

-  move  to  library  NSRDC 
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**** 


QUAL  LOG  **** 


Get  the  value  of  an  logical  qualifier  (/qual  or  /NOqual) . 

Usage:  CHARACTER  QUAL_FIELD  *  (nf) ,  QUAL_NAME  *  (nn) 

CHARACTER  WORK_NAME  *  (nn+2) 

INTEGER  MINCH,  QUAL_VALUE 
LOGICAL  QUAL_LOG 

IF  (QUAL_LOG  (QUAL_NAME ,  W0RK_NAME,  MINCH,  QUAL_FIELD, 
QUAL_VALUE) )  THEN 


See  also  QUAL_CHAR,  QUAL  INT,  PARS. 


*** 


Parameters 

QUAL_L0G  (QUAL_NAME,  WORK_NAME ,  MINCH,  NOMINCH,  QUAL_FIELD,  QUAL_VALUE) 

QUAL_NAME  -  in  ch**  -  qualifier  name  (e.g.  ,  '/QUAL') 

WORK_NAME  -  scr  -  ch**  ~  work  variable  of  length  >=  LEN (QUAL_NAME) +2 

MINCH  -  in  -  int  -  minimum  number  of  characters  to  be  tested 

(if  MINCH® 1 ,  then  /Q,  /QU,  /QUA  and  /QUAL 
are  recognized) 

QUAL_FIELD  -  in  ch’r,r  -  field  to  be  checked  and  evaluated 

QUALVALUE  -  out  -  log  -  returned  value  of 

TRUE  -  /qual  was  found 
FALSE  -  /noqual  was  found 


QUAL_LOG  -  out  -  log  -  TRUE  -  QUAL_FIELD  was  QUAL_NAME  and  a  value 

has  been  returned 

FALSE  -  QUAL_FIELD  is  not  QUAL_NAME  and  no 
value  is  returned 


*** 


Example  *** 


QUAL._L0G  (QUAL_NAME ,  W0RK_NAME ,  MINCH,  NOMINCH,  QUAL_FIELD,  QUAL_VALUE) 

After  extracting  the  qualifier,  see  if  it  is  /SUPPRESS  or  /NOSUPPRESS. 

CHARACTER  *  15  QUAL_FIELD 
CHARACTER  *  11  W0RK_NAME 
LOGICAL  QUAL_L0G,  QUAL_VALUE 

IF  (QUAL_L0G  ('/SUPPRESS',  W0RK_NAME,  1,  QUAL_FIELD, 
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&  QUAL_VALUE) )  THEN  y.«.- 

<the  qualifier  was  /SUPPRESS> 

ELSE 

<the  qualifier  was  /NOSUPPRESS> 

END  IF 


Admin  info  *** 


Language:  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  03/27/85 

Dates  revised 
05/15/85  -  ? 

08/07/85  -  change  name  from  GETQULC  to  QUAL_CHAR 

-  generalize  by  adding  W0RK_NAME  and  WORK_FIELD  parameters 

-  move  to  library  NSRDC 
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****  REPLAC  **** 

Integer  function  to  translate  characters  into  other  characters. 

Usage:  CHARACTER  STRING  *  (nl) 

CHARACTER  FROM  *  (n2) 

CHARACTER  TO  *  (n2) 

INTEGER  REPLAC,  N_REPLACED 

N_REP LACED  -  REPLAC  (STRING,  FROM,  TO) 


Parameters  *** 


REPLAC  (STRING, 

FROM, 

TO) 

STRING  - 

i/o  - 

ch**  - 

string 

9 

to 

be  translated 

FROM 

in 

ch**  - 

string 

of 

character  to  be  replaced 

TO 

in 

ch**  - 

string 

of 

replacement  characters 

REPLAC  - 

out  - 

int 

will  contain  one  of: 

+n  -  the  number  of  characters  replaced 
0  -  no  replacement  done 
-1  -  no  replacement  done  because 
LEN (TO)  <>  LEN (TO) 

-2  -  no  replacement  done  because 
FROM  or  TO  was  empty 

Each  occurrence  of  FR0M(i:i)  in  string  is  changed  to  T0(i:i). 


icff'k 


Example  *** 


character  line  *  20 

character  from  *  26  /  ' abcdefghi jklmnopqrstuvwxyz' / 
character  to  *  26  /  'ABCDEFGHI JKLMNOPQRSTUVWXYZ ' / 
integer  l_line,  n_replaced,  replac 

read  '(a)',  l_line,  line 

n_replaced  ”  replac  (1 ine  (: 1_1 ine ,  from,  to) 

Assuming  that  the  line  read  contains  'John  &  Mary  User',  then  LINE 
becomes  'JOHN  &  MARY  USER'  and  N  REPLACED  -  9. 


/f  *  * 


Related  commands 


REPLAC  -  replace  characters  by  characters 
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REPLEQ  -  replace  character*  by  a  character 

REPLNE  -  replace  non-specif ied  characters  by  a  character 

***  Admin_info  *** 

Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  02/14/86 
Dates  revised 
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****  REPLEQ  **** 


Integer  function  to  translate  characters  into  a  single  character. 

Usage:  CHARACTER  STRING  *  (nl) 

CHARACTER  FROM  *  (n2) 

CHARACTER  TO  *  1 

INTEGER  REPLEQ,  N_REPLACED 

N_REPLACED  -  REPLEQ  (STRING,  FROM,  TO) 


*** 

REPLEQ  (STRING, 

FROM, 

TO) 

STRING  - 

i/o  - 

ch** 

FROM 

in 

ch** 

TO 

in 

ch*l 

REPLEQ  - 

out  - 

int 

# 

Each  occurrence  of  FROM(i:i) 


Parameters 


string  to  be  translated 

string  of  character  to  be  replaced 

replacement  character 

will  contain  one  of: 

+n  -  the  number  of  characters  replaced 
0  -  no  replacement  done 
-1  -  no  replacement  done  because 
LEN (TO)  >  1 

-2  -  no  replacement  done  because 
FROM  or  TO  was  empty 

in  string  is  changed  to  TO. 


***  Examples  *** 

Replace  all  digits  with  a  minus  sign  (-) : 

character  string  *  80 
integer  n_replaced,  repleq 

n_replaced  *  repleq  (string,  '0123456789',  '-') 


***  Related_commands  *** 

REPLAC  -  replace  characters  by  characters 

REPLEQ  -  replace  characters  by  a  character 

REPLNE  -  replace  non~specif ied  characters  by  a  character 


Jc/rtc 


Admin  info 
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•y* 

Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  02/14/86 
Dates  revised 
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****  REPLNE  **** 

Integer  function  to  translate  unspecified  characters  into  a  single  character. 

Usage:  CHARACTER  STRING  *  (nl) 

CHARACTER  FROM  *  (n2) 

CHARACTER  TO  *  1 

INTEGER  RF°LNE,  N_REPLACED 

N  REPLACED  =  REPLNE  (STRING,  FROM,  TO) 


Vr  Vc 


Parameters 


*** 


REPLNE  (STRING,  FROM,  TO) 

STRING  -  i/o  -  ch’”':  -  string  to  be  translated 

FROM  -  in  -  ch**  -  string  of  characters  NOT  to  be  replaced 

TO  -  in  -  ch*l  -  replacement  character 

REPLNE  -  out  -  int  -  will  contain  one  of: 

+n  -  the  number  of  characters 
replaced 

0  -  no  replacement  done 

-1  -  no  replacement  done  because 

LEN (TO)  >  1 

-2  -  no  replacement  done  because 
FROM  or  TO  was  empty 

Each  non-occurrence  of  FROM(i:i)  in  string  is  changed  to  TO. 


***  Examples  *** 

Replace  everything  but  digits  with  a  blank: 

character  string  *  80 
integer  nreplaced,  repine 

n_replaced  *  repine  (string,  ’0123^56789’,  ’  ’) 

***  Related_commands  *** 
REPLAC  -  replace  characters  by  characters 


REPLEQ  -  replace  characters  by  a  character 

REPLNE  -  replace  unspecified  characters  by  a  character 
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***  Admin_in£o  *** 

Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  02/14/86 
Dates  revised 
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****  REVERSE  **** 

Subroutine  to  reverse  the  order  of  the  characters  in  a  character  string. 
Usage:  CHARACTER  STRING  *  (n) 

CALL  REVERSE  (STRING) 


Parameters 


CALL  REVERSE  (STRING) 

STRING  -  i/o  -  ch**  -  st  ring  to  be  reversed 


*** 


Example  *** 


CHARACTER  LINE  *  26  /  'abcdefghi jklmnopqrstuvwxyz'  / 
•  •  • 

TYPE  *,  'Before:  'LINE 
CALL  REVERSE  (LINE) 

TYPE  *,  'After:  'LINE 

resuLts  in  the  following  two  lines  being  typed: 

Before :  abcdefghi jklmnopqrstuvwxyz 
After :  zyxwvutsrqponmlk j ihgf edcba 
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(  ****  RIGHT  **** 

Integer  function  to  right-justify  a  character  string.  The  stri 
justified  within  itself. 

t 

;  Usage:  CHARACTER  STRING  *  (n) 

I  CHARACTER  WORK  *  (n) 

J  INTEGER  LSTRING,  RIGHT 

|  LSTRING  -  RIGHT  (STRING,  WORK) 

i 


*** 


Parameters 


CALL  RIGHT  (STRING,  WORK) 
STRING  -  i/o  -  ch** 


f 


WORK  -  -  ch*5'1 

RIGHT  -  out  -  int 


string  to  be  right-justif ied 
work  variable  of  len(string) 
the  position  of  the  last  non-blank 


***  Example  *** 


CHARACTER  LINE  *  80 
CHARACTER  WORK  *  80 
INTEGER  LLINE,  RIGHT 
•  •  • 

READ  ' (A) ' ,  LINE 

LLINE  -  RIGHT  (LINE,  WORK) 

If  LINE  contains  '  Some  words  ',  then  after  right  jus 

will  contain  '  Some  words',  and  LLINE  =  20. 

1 . . . 5. . . 10. . . 15. . . 20 


I 

f 


l 

i 


is  right- 


ifying,  it 
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X 


****  S2HMS  **** 

Convert  seconds  to  hh:mm:ss. 

Usage:  CHARACTER  *  (n)  HMS,  S2HMS 

INTEGER  SEC 

HMS  -  S2HMS  (SEC) 

(n)  must  be  at  least  big  enough  (minimum  8)  to  hold  the  complete  output. 
See  also  HMS2S  to  convert  back  to  seconds. 


S2HMS  (SEC) 


Parameters 


-  int  ~  seconds  to  be  converted 


S2HMS  -  out  -  ch**  -  time  converted  to  hh:mm:ss 


Examples  *** 


1)  Convert  seconds  to  hh:mm:ss. 

CHARACTER  HMS  *  8 ,  S2HMS  *  8 
INTEGER  TIM 
•  •  • 

TIM  -  61 

HMS  *  S2HMS  (TIM) 

HMS  will  contain  '00:01:01'. 


2)  Subtract  3.5  hours  from  the  current  time.  Note  that  there  are  other 
ways  to  do  this.  This  assumes  that  the  current  time  is  after  3:30  am. 

CHARACTER  NOW  *  8,  NEWTIM  *  8,  S2HMS  *  8 
INTEGER  HMS2S 
CALL  TIME  (NOW) 

NEWTIM  -  S2HMS  (HMS2S (NOW) -HMS2S ( ' 3: 30: ' ) ) 


***  Admin  info  *** 


IVSVIV 
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Language:  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 

Date  written:  05/08/74  (ihms) 

Dates  revised 

03/18/83  -  convert  to  Fortran  77 

-  change  name  from  ihms  to  s2hms 
07/08/85  -  implement  on  VAX/VMS 

-  allow  for  more  than  99  hours 

-  allow  for  negative  seconds 
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****  SET_BIT  **** 

Set  one  bit  in  a  bit  array  (bit  string). 

Usage:  CALL  SET_BIT  (BITNO.ri.r,  BITS.mv.r) 

See  also  CLR_BIT,  FLP_BIT,  TST_BIT;  help  module  BIT_PKG. 

***  Parameters  *** 

CALL  SET_BIT  (BITNO.ri.r,  BITS.mv.r) 

BITNO  -  in  -  int  -  the  number  of  the  bit  to  be  set 
BITS  -  i/o  -  -  the  bit  string  or  array 


***  Example  *** 

Set  bit  76  in  a  100-bit  table: 

INTEGER  N_BITS ,  BITS_WORD,  N_WORDS 
PARAMETER  (  BITS_WORD  =  32  !  integer*^  word 

N  ,  N_BITS  *  100  !  in  bit  array 

N  ,  N_WORDS  -  (N_BITS  +  BITSWORD  -  1)  /  BITS_WORD 

)  ) 

INTEGER  BITNO,  TABLE (N_WORDS) 

BITNO  =  76 

CALL  SET_BIT  (BITNO,  TABLE) 


Admin  info  *** 


Author:  F.  Nagy  -  Fermilab  Accelerator  Control  System 

Languages :  MACRO 

Date  written:  01/17/83 
Dates  revised 
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****  SIGDIG  **** 

Return  number  of  significant  digits  (including  1  for  a  minus  sign,  if  needed) 

Usage:  integer  n,  n_digits,  sigdig 

n_digits  =  sigdig  (n) 

This  is  useful  for  left-justifying  integers  in  an  output  format.  Use 
"I<sigdig (number) >"  in  the  format  statement. 

NOTE:  "number"  is  only  tested  for  up  to  9  significant  places  (+  1,  if 

negative).  If  the  absolute  value  of  "number"  is  greater  than  this, 

-1  is  returned. 


Parameters 


*>v* 


number  -  in 

-  int 

-  number  to  be  tested 

sigdig  -  out 

-  int 

-  number  of  significant 
(if  | number \  >  10**8, 

digits 

sigdig 

(+  1  if 
=  -1) 

negative) 


***  Examples  **,c 

# 

Print  the  message  "The  file  has  <n>  records.",  where  <n>  is  in  the  variable 
NRECS  and,  for  this  example,  has  the  value  123: 

PRINT  *,  'The  file  has  ' ,  n,  '  records.' 

will  print  "The  file  has  123  records. 

PRINT  1,  n 

1  FORMAT  ('The  file  has  ',  I <s igdig (n) > ,  '  records.') 
will  print  "The  file  has  123  records. 


>v  y?  * 


Admin  info  ** 


Language : 

Author : 

Date  written: 

Dates  revised 
06/10/85  - 


DEC  VAX/VMS  Fortran  77 
David  V.  Sommer  -  DTNSRDC  Code 
11/16/81 

convert  to  VAXcluster 


1892.2 
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Sum  a  real  array. 

Usage:  INTEGER  NELTS 

REAL  ARRAY (NELTS)  ,  sum,  total 

TOTAL  =  SUM  (ARRAY,  NELTS) 

See  also  ISUM. 


Parameters  *** 


SUM  (ARRAY,  NELTS) 


ARRAY  -  i/o  -  real  -  array  to  be  summed 

NELTS  -  in  int  -  number  of  elements  to  be  summed 

SUM  -  out  -  int  -  the  sum 


Example 


Sum  a  10-element  real  array. 

REAL  NUM (10)  /  !  array  to  be  summed 
A  A.,  77.,  12.,  A.,  99.,  100.,  88.,  13.,  123.,  -5./ 

INTEGER  NELTS  /  10  /  !  number  of  records  to  be  summed 
REAL  SUM,  TOTAL 


TOTAL  =  SUM  (NUM,  NELTS) 

After  the  call,  TOTAL  will  contain  515.0. 
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****  SWAPCASE  **** 

Swap  upper  and  lower  case.  That  is,  convert  lower  case  and  upper  case  to 
upper  case  and  lower  case,  respectively.  Non-alphabetic  characters  are 
not  changed. 

Usage:  CHARACTER  STRING  *  (n) 

•  •  • 

CALL  SWAPCASE  (STRING) 


***  Parameter  *** 

CALL  SWAPCASE  (STRING) 

STRING  -  i/o  -  ch**  -  string  to  be  translated  in  place 


*** 


Examples  *** 


If  STRING  contains 

' AbCdEf GhI jKIMnOpQrStUvWxYz ' 
then  after  CALL  SWAPCASE  (STRING),  STRING  will  contain 
' aBcDeFgHi JkLmNoPqRsTuVwXyZ ' 


# 
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****  gy  **** 


Solve  a  tridiagonal  system  of  equations  following  the  Thomas  algorithm. 

Usage;  INTEGER  FIRSUB,  LSTSUB 

REAL  BEHINDC*),  DIAG(*) ,  AHEAD (*) ,  CNSTVC(*) 

CALL  SY  (FIRSUB,  LSTSUB,  BEHIND,  DIAG,  AHEAD,  CNSTVC) 


***  Parameters  *** 

CALL  SY  (FIRSUB,  LSTSUB,  BEHIND,  DIAG,  AHEAD,  CNSTVC) 

FIRSUB  -  in  int  -  subscript  of  first  equation 

LSTSUB  -  in  int  -  subscript  of  last  equation 

BEHIND  -  in  real  -  coefficient  behind  of  diagonal 

DIAG  -  i/o  -  real  -  coefficient  on  diagonal 

AHEAD  -  in  real  -  coefficient  ahead  of  diagonal 

CNSTVC  -  i/o  -  real  -  element  of  constant  vector 

(will  contain  the  solution) 

***  Remarks  *** 

To  use  this  subroutine,  the  equations  must  be  of  the  form 


|  D 

A 

1 

1 

|u  ! 

jc  j 

|  firsub 

firsub 

1 

1 

|  firsubj 

j  firsubj 

!  B 

D 

A  | 

|U  ! 

jc  j 

[  i 

i 

i  j 

|  i  ! 

!  i  ! 

■ 

i 

f  1 

1  *  1 

1  l 

• 

i 

•  •  i 

1  1 
|  *  | 

1  l 

I 

b  d  ; 

lstsub  lstsubj 

i 

1  1 

!u  ! 

!  lstsubj 

i  i 

l  1 

1  •  1 

jc  j 

j  lstsubj 

i  i 

The  equations  in  the  system  are  ordered  according  to  the  value  of  the 
subscript.  The  variable  FIRSUB  corresponds  to  the  subscript  of  the  first 
equation  in  the  system  and  LSTSUB  corresponds  to  the  subscript  of  the 
last  equation  in  the  system.  The  number  of  equations  in  the  system  is 
LSTSUB  -  FIRSUB  +  1.  The  solution  vector  U  is  returned  to  the  calling 
program  in  the  CNSTVC  array.  That  is,  the  constant  vector  CNSTVC  is 
overwritten  in  the  subroutine  with  the  solution.  The  DIAG  array  is  also 
altered  by  the  subroutine.  AHEAD  and  BEHIND  remain  unchanged. 
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***  Reference  *** 

"Computational  Fluid  Mechanics  and  Heat  Transfer",  by  Dale  A.  Anderson, 
John  C.  Tannehill,  Richard  H.  Pletcher,  Hemisphere  Publishing  Corporation/ 
McGraw-Hill  Book  Company,  pages  549-550  and  Chapter  4. 
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****  TERMINAL  **** 

For  interactive  users,  get  the  terminal  name. 

Usage:  CHARACTER  *  8  TERM 

INTEGER  LTERM 

CALL  TERMINAL  (TERM,  LTERM) 


***  Parameters  *** 
CA(.L  TERMINAL  (TERM,  LTERM) 

TERM  -  out  -  ch*8  -  the  terminal  name 
LTERM  -  out  -  int  -  the  length  of  term 


***  Examples  *** 

CHARACTER  JPMODE  *  11,  TERM  *  8 
INTEGER  LTERM 
•  •  • 

IF  (JP_MODE  ()  .EQ.  'INTERACTIVE')  THEN 
CALL  TERMINAL  (TERM,  LTERM) 

•  •  • 

ELSE 
•  •  • 

END  IF 

***  Admin_inf o  *** 

Language:  DEC  VAX/VMS  Fortran  77 

Author:  David  V.  Sommer  -  DTNSRDC  Code  1892.2 


Date  written:  08/21/85 
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****  TRANS  **** 

Translate  characters  according  to  translate  tables  you  specify  in  the 
call. 

Usage:  CHARACTER  STRING  *  (nl) 

CHARACTER  FROM  *  (n2) 

CHARACTER  TO  *  (n2) 

DATA  /FROM  /  ' <f rom~characters> ' / 

DATA  /TO  /  ' <to~characters> ' / 

CALL  TRANS  (STRING,  FROM,  TO) 


***  Parameters  *** 

CALL  TRANS  (STRING,  FROM,  TO) 

STRING  -  i/o  -  ch**  -  string  to  be  translated 

FROM  -  in  -  ch**  -  string  of  character  to  be  translated 

TO  -  in  -  ch**  -  string  of  translation  characters 

Remarks:  Each  occurrence  of  FR0M(i:i)  in  string  is  changed  to  TO(i: 

See  also  integer  function  ITRANS. 


Example  *** 


CHARACTER  LINE  *  20 

CHARACTER  FROM  *  26  /  ' abcdefghi jklmnopqrstuvwxyz' / 
CHARACTER  TO  *  26  /  ' ABCDEFGHI JKLMNOPQRSTUVWXYZ ' / 

READ  ' (A) ' ,  LINE 

CALL  TRANS  (LINE,  FROM,  TO) 


This  example  will  change  lower  case  letters  to  upper  case. 
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****  TST_ARG_DFT  **** 

In  a  subprogram,  test  whether  a  specific  argument  in  the  call  exists  and 
is  not  defaulted. 

Usage:  SUBROUTINE  SUB  (<args>) 

LOGICAL  EXISTS,  TST_ARG_DFT 
EXISTS  =  TST  ARG  DFT  (NARG) 


***  Parameters  *** 

EXISTS  =  TSTARGDFT  (NARG) 

NARG  -  in  -  byte  -  the  argument  number  to  be  tested  for 

TST_ARG_DFT  -  out  -  log  -  TRUE  -  the  narg-th  argument  is  given 

in  the  outer  procedure  argument 
list  and  is  not  defaulted 
(argument  value  is  non-zero) 
FALSE  -  narg  is  greater  than  the  number 
of  arguments  possible 
-  the  value  of  the  NARG-th 
argument  is  zero 


*  rtrt 


Example  *** 


EXISTS  =  TST  ARG  DFT  (NARG) 


PROGRAM  TEST 

CALL  SUB  (ARG1,  ,  ARG3) 

END 


SUBROUTINE  SUB  (Al,  A2,  A3) 

LOGICAL  EXISTS,  TST_ARG_DFT 
IF  (TST_ARG_DFT  (NARG))  THEN 
<code  requiring  A2> 

ELSE 

<code  not  requiring  A2> 

END  IF 
RETURN 
END 

1j 

* 


Language:  MACRO 


Admin  info 


*** 


Author:  F.  Nagy  -  Fermilab  Accelerator  Control  System  -  ACNET 


Date  written:  06/07/82 
Dates  revised 


86/05/30  VAX  NSRDC  TST  ARG  DFT 


06/08/82  -  04/15/83  -  09/02/83  -  10/19/84 
08/16/85  -  LIB_  removed  from  routine  name 
-  added  to  NSRDC. OLB  at  DTNSRDC 
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****  TST  BIT  **** 

Test  one  bit  in  a  bit  array  (bit  string). 

Usage:  LOGICAL  BIT_SET,  TST_BIT 

BIT_SET  =  TST_BIT  (BITNO.rl.r,  BITS.mv.r) 

See  also  CLR_BIT,  FLP_BIT,  SET_BIT;  help  module  BIT_PKG. 


o’c 


Parameters 

TST_BIT  (BITNO.rl.r,  BITS.mv.r) 

BITNO  -  in  -  int  ~  the  number  of  the  bit  to  be  tested 

BITS  -  i/o  -  -  the  bit  string  or  array 

TSTBIT  -  out  -  log  ~  TRUE  -  the  bit  is  set 

FALSE  -  the  bit  is  not  set 


a 


*  >V  5\r 


*  it  * 


Example 

Test  bit  76  in  a  100-bit  table  and  print  a  message: 

INTEGER  N_B ITS ,  BITS_WORD,  N_WORDS 
PARAMETER  (  BITS_WORD  -  32  !  integer**  word 

N  ,  N_BITS  =*  100  !  in  bit  array 

N  ,  N  WORDS  =  (N_BITS  +  BITS_W0RD  -  1)  /  BITS_WORD 

)  ) 

INTEGER  BITNO,  TABLE (N_W0RDS) 

LOGICAL  TST_BIT 

BITNO  -  76 


IF  (TST  BIT 

(BITNO, 

TABLE)) 

THEN 

PRINT  *, 

'Bit  ', 

BITNO, 

'  is 

ELSE 

PRINT  *, 

'Bit  ', 

BITNO, 

*  is  : 

END  IF 


,v  ,v  Admin  info  *** 


& 

^y 


Author:  F.  Nagy  -  Fermilab  Accelerator  Control  System 

Languages:  MACRO 

Date  written:  01/17/83 
Dates  revised 


' 


in  II  1MB 
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****  UP2L0  **** 

Convert  upper  case  to  lower  case.  Non-alphabet ic  characters  are  not 
changed. 

Usage:  CHARACTER  STRING  *  (n) 

CALL  UP2L0  (STRING) 


*** 


Parameter 


>V  ?'r  * 


CALL  UP2L0  (STRING) 


STRING  -  i/o  -  ch**  -  string  to  be  translated  in  place 


Examples  *** 


If  STRING  contains 

' AbCdEfGhI jKIMnOpQrStUvWxYz ' 
then  after  CALL  UP2LO  (STRING),  STRING  will  contain 
' abcdefghi jklmnopqrstuvwxyz' . 
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K 


****  UPPER  ***’• 


Test  a  character  for  upper  case  letter. 

Usage:  CHARACTER  *  1  CH 

LOGICAL  UPPER 

IF  (UPPER (CH))  THEN 


Parameters 


*** 


UPPER  (.CH ) 

CH  -  in  -  ch*l  -  character  to  be  tested 

UPPER  -  out  -  log  -  TRUE  -  CH  is  an  upper  case  letter 

FALSE  -  CH  is ‘not  an  upper  case  letter 


Example 


Read  a  character  string  and  flag  all  upper  case  letters. 

CHARACTER  STRING  *  50,  FLAGS  *  50 
FLAGS  =  '  ' 

READ  (*,  '(A)’)  STRING 
DO  110  N=1 ,50 

IF  (UPPER  (STRING (N:N) ) )  FLAGS (N:N)  =  ' A ' 

110  CONTINUE 

PRINT  *,  STRING 
PRINT  *,  FLAGS 


Then,  for  STR ING= ' abcde  FGHIJ  kLmnO  pQRst  UvWxy  Z 1 234567890 () $ 

FLAGS  ='  A  A  A  A  A  A  A  AA 
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****  USERID  **** 

Obtain  the  user  initials  of  the  job/session  running  the  program. 

Usage:  CHARACTER  ID  *  10 

INTEGER  LID 

CALL  USERID  (ID,  LID) 


***  Parameters  *** 

CALL  USERID  (ID,  LID) 

ID  -  out  -  ch**  -  user  initials 
LID  -  out  -  int  -  length  of  ID 


*** 


Example 


CHARACTER  ID  *  10 
INTEGER  LID 
•  •  • 

CALL  USERID  (ID,  LID) 

TYPE  *,  'Your  User  ID  is  ID(:LID)  , 
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****  V2CDAT  **** 

Convert  VMS  format  date  (dd-mmm-yy)  to  CDC  format  (mm/dd/yy) . 
Usage:  CHARACTER  CDC  *  8,  VMS  *  9 

CALL  V2CDAT  (VMS,  CDC) 


***  Parameters  *** 

CALL  V2CDAT  (VMS,  CDC) 

VMS  -  in  ch5C9  -  VMS  format  date  to  be  converted  (dd-mmm-yy) 
CDC  -  out  -  ch*8  -  CDC  format  converted  date  (mm/dd/yy) 


ft*  it 


Example  *** 


CHARACTER  CDC  *  8,  VMS  *  9 
•  •  • 

CALL  DATE  (VMS) 

CALL  V2CDAT  (VMS,  CDC) 

TYPE  *,  'VMS  date  is  ',  VMS 
TYPE  *,  'CDC  date  is  ' ,  CDC 


results  in  the  following  output: 


VMS  date  is  ll-APR-85 
CDC  date  is  04/11/85 


i 

f 
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****  WEKDAY  **** 

Determine  the  day  of  the  week  for  any  Gregorian  date  from  October  15,  1582 
thru  February  28,  4000. 

Usage:  CALL  WEKDAY  (ERR.wl.r,  DAY.wl.r,  GY.rl.r,  GM.rl.r,  GD.rl.r) 

Dates  from  January  1,  1582  thru  October  14,  1582  and  from  March  1,  4000 
thru  December  31,  4000  are  not  validated. 

Method:  See  IBM  Program  Description  360D-03. 1.004. 


Parameters 
CALL  WEKDAY  (ERR,  DAY,  GY,  GM,  GD) 


ERR  - 

out 

-  int 

-  return  code 

0  -  no  error 

1  -  at  least  one  of  GY,  GM,  GD 

DAY  - 

out 

-  int 

-  return  day  of  week 

0  (Sunday)  thru  6  (Saturday) 

GY  - 

in 

-  int 

-  Gregorian  year  (e.g.,  1985) 

GM  - 

in 

-  int 

-  Gregorian  month  ( 1— 12) 

GD  - 

in 

-  int 

-  Gregorian  day  (1—31) 

***  Examples  *** 
Find  the  day  of  the  week  for  23  September  1985: 


PROGRAM  SAMPLE 
IMPLICIT  NONE 

INTEGER  ERR,  DAY,  GY,  GM,  GD 

CHARACTER  WD(0:6)  *  9  /  'Sunday',  'Monday',  'Tuesday',  'Wednesday', 
a  'Thursday',  'Friday',  'Saturday'  / 

GY  -  1985 
GM  -  9 
GD  -  23 

CALL  WEKDAY  (ERR,  DAY,  GY,  GM,  GD) 

PRINT  3,  GM,  GD,  GY,  WD(DAY) 

3  FORMAT  (13.2,  '/',  12.2,  '/’,  14,  '  is  a  ',  A) 

END 


***  Admin  info  *** 


Language: 


Fortran  77 
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Author:  Richard  L.  Conner  -  IBM 

Date  written:  10/15/66 
Dates  revised 

04/26/73  -  rewritten  in  Fortran  for  CDC  6700  -  DVS 
09/23/85  -  implement  on  VAXcluster  -  DVS 
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*****  Index  ***** 
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